Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

UserForm Focus Problem

Status
Not open for further replies.
gloudo

gloudo

Programmer
Feb 3, 2002
34
NL
I have A userform wich must be shown while running a macro.
The userform pops up like it should be, but the form is empty because it lost the focus. My question is:

Is there a simple way to keep the focus on the userform while the macro runs?

Thanks
 
Sort by date Sort by votes
Which application are you running?

If I create a Userform with some controls on it (label, textbox, etc.) and run the following procedure, the form displays & keeps the focus while the loop runs until the messagebox displays.
Code: 
Sub Test()
Dim i As Long

   UserForm1.Show vbModeless
   For i = 1 To 100000
     DoEvents
   Next i
   MsgBox "Done"
End Sub

Regards,
Mike
 
Upvote 0 Downvote
The problem is the macro is not loopable.
And the form is Just a standby message with an Image.

See below:

Code: 
Sub Main()

Application.ScreenUpdating = False
    
    With UserForm1
    .Caption = "Bezig met opdracht..."
    End With
    
        
    Sheets("Amsterdam").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Amsterdam.dqy" _
        , Destination:=Range("A1"))
        .Name = "Amsterdam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Dordrecht").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Dordrecht.dqy" _
        , Destination:=Range("A1"))
        .Name = "Dordrecht"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Zwolle").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Zwolle.dqy", _
        Destination:=Range("A1"))
        .Name = "Zwolle"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = "&A"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = "&A"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    Sheets("Dordrecht").Select
    With ActiveSheet.PageSetup
        .LeftHeader = "&A"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = "&A"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    Sheets("Amsterdam").Select
    With ActiveSheet.PageSetup
        .LeftHeader = "&A"
        .CenterHeader = ""
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    
    Application.ScreenUpdating = True
    Worksheets(1).Select
    
    UserForm1.Hide
    Unload UserForm1
End Sub
 
Upvote 0 Downvote
The loop was just something for the Sub to do while the Userform was being displayed. I have gone back and added code similar to yours (e.g. adding a QueryTable, setting PageSetup properties, etc.) but I cannot duplicate the behavior you are seeing. In my case, the Userform displays and maintains focus while the remaining code runs. At the end of the procedure, I see the switch to the selected worksheet that was invisible until application.ScreenUpdating was set to True.

Where is your code to display the Userform?

Mike
 
Upvote 0 Downvote
Here is my code for displaying the Userform

Code: 
Sub Query()
 
    Load UserForm1
    UserForm1.Show

End Sub

The code on activation

Code: 
Sub UserForm_Activate()

    Call Main

End Sub

and I made some changes to my main macro.

The problem occurs at: Sheets("Amsterdam").Select

Code: 
Sub Main()

   Application.ScreenUpdating = False
    
    With UserForm1
    .Caption = "Bezig met opdracht..."
    End With
    
        
    Sheets("Amsterdam").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Amsterdam.dqy" _
        , Destination:=Range("A1"))
        .Name = "Amsterdam"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Dordrecht").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Dordrecht.dqy" _
        , Destination:=Range("A1"))
        .Name = "Dordrecht"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Zwolle").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\Documents and Settings\Thijs\Mijn documenten\Adressen\Zwolle.dqy", _
        Destination:=Range("A1"))
        .Name = "Zwolle"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    
    Dim ws As Worksheet, i As Long
    Application.ScreenUpdating = False
    i = 0
    For Each ws In ActiveWorkbook.Worksheets
        i = i + 1
        If i >= 2 Then
            Application.StatusBar = "Changing header/footer in " & ws.Name
            With ws.PageSetup
                .LeftHeader = "&A"
                .CenterHeader = ""
                .RightHeader = "&D"
                .LeftFooter = ""
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = Application.InchesToPoints(0.78740157480315)
                .RightMargin = Application.InchesToPoints(0.78740157480315)
                .TopMargin = Application.InchesToPoints(0.984251968503937)
                .BottomMargin = Application.InchesToPoints(0.984251968503937)
                .HeaderMargin = Application.InchesToPoints(0.511811023622047)
                .FooterMargin = Application.InchesToPoints(0.511811023622047)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = False
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperA4
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = 100
            End With
        End If
    Next ws
    Set ws = Nothing
    
    Worksheets(1).Select
    Application.ScreenUpdating = True

    
    UserForm1.Hide
    Unload UserForm1
End Sub
 
Upvote 0 Downvote
I have changed my example code to mimic yours and still no "luck"; i.e. my Userform retains focus until the code completes.

Some additional questions:

You said your Userform contains a message and image. So, it uses Label and Image controls? I assume you loaded the actual graphic at design-time? What do you mean when you say the displayed Userform is blank because it loses focus? Do the message text and graphic disappear? That would not be normal behavior.

What version of Excel?


Regards,
Mike
 
Upvote 0 Downvote
My Excel Version is 2000

Whith the focus loss The Frame of the UserForm Stay's visible, but the The middle of the form is completely white.

The Picture and the message are indeed a label and an image control. Both inserted in design-time.
Even When I Remove both the msg and img the Form gets white while running the macro.

Is there a place I can Sent you My full code? So you can see the whole.

Greetings,

Thijs
 
Upvote 0 Downvote
Have you tried to play with the DoEvents function ?
You may also set ScreenUpdating to False a bit later ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Upvote 0 Downvote
Hi gloudo,

Try adding ...
Code: 
[blue]Userform1.Repaint[/blue]
after setting the caption to force the screen display to be 'current'.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
Upvote 0 Downvote
PHV & Tony are on to something. I left the loop code (see my first post) in containing a DoEvents statement not thinking it was having any effect. When I removed it, my code mock-up did indeed exhibit the same white-out behavior in the Userform. A single DoEvents statement or Userform.RePaint before the main worksheet selection, etc. code seems to do the trick.

Mike
 
Upvote 0 Downvote
Yeeeha, It worked great.
I put the Userform.repaint in the "With" instruction
And it workt flawless.

Thanks Everyone

Greetings

Thijs
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

huiettcm
  • Locked
  • Question
Excel UserForm Window 'Focus' Event Listener 1
Replies
14
Views
326
huiettcm
huiettcm
JPJeffery
  • Locked
  • Question
Hiding an Excel workbook loses focus 3
Replies
14
Views
328
combo
combo
AncientTiger
  • Locked
  • Question
How to screenshot a userform and save the capture as JPG 1
Replies
7
Views
593
AncientTiger
AncientTiger
thanhthanh12
  • Locked
  • Question
How create a button to record a macro in userform
Replies
5
Views
154
thanhthanh12
thanhthanh12
JTBorton
  • Locked
  • Question
Determine when a userform is closes without the Terminate event 1
Replies
6
Views
396
JTBorton
JTBorton

Part and Inventory Search

Sponsor

Back
Top