Document focus changes when userform opens

  • Thread starter christophercbrewster via OfficeKB.com
  • Start date
C

christophercbrewster via OfficeKB.com

[This is an outgrowth of a previous thread, "Option group needs to show
current value ", but it's a different problem so I thought I should start
over.]

When I have more than one document open and activate a userform, the focus (I
think that's the right term for whatever is considered the ActiveDocument)
switches to the first document that was opened. The result is unexpected and
misleading for the user.

I'm including all the code that I think would affect this, in order of
shortest to longest. [Some details are changed for proprietary issues, but
nothing affecting the logic.]

Thanks for any help.

-------------------------------------------------------------------
Routine that calls the userform:
------------------------
Private Sub menuForm()

' Check to see that the file has been saved for the first time
If ActiveDocument.Path = "" Then
MsgBox "Please save your document."
On Error Resume Next
ActiveDocument.Save
If Err <> 0 Then Exit Sub
End If

PptTaggingFunct.Show

End Sub
------------------------------------------------------------------

Code for the userform:
------------------

Private Sub UserForm_Activate()

' The following sets defaults for the two option groups (Bold font, include
title) if they are
' not already set. Then it sets the button values to show the current
settings.

On Error Resume Next ' Read IncludeTitle option
sTitleSetting = ActiveDocument.Variables("include-title").Value
If Err.Number <> 0 Then ' If it's not set, set it to "True" string
value
ActiveDocument.Variables("include-title").Value = "True"
sTitleSetting = "True"
End If

On Error Resume Next ' Read Font option
sFontSetting = ActiveDocument.Variables("font").Value
If Err <> 0 Then ' If font isn't set, set it to "Bold" string
value
ActiveDocument.Variables("font").Value = "Bold"
sFontSetting = "Bold"
End If

Select Case sFontSetting ' Set Font buttons depending on current
setting
Case "Bold"
BoldOption.Value = True
MatchTextOption.Value = False
RegularOption.Value = False
Case "Regular"
BoldOption.Value = False
MatchTextOption.Value = False
RegularOption.Value = True
Case "Context"
BoldOption.Value = False
MatchTextOption.Value = True
RegularOption.Value = False
End Select

Select Case sTitleSetting ' Set InclTitle buttons depending on current
setting
Case "True"
YesOption.Value = True
NoOption.Value = False
Case "False"
YesOption.Value = False
NoOption.Value = True
End Select

BoldOption.GroupName = "Fonts"
MatchTextOption.GroupName = "Fonts"
RegularOption.GroupName = "Fonts"

YesOption.GroupName = "InclTitle"
NoOption.GroupName = "InclTitle"

End Sub

------------------------------------------------------------------------------
--------
Declarations and Auto_Exec that creates the toolbar:
---------------------------
Public wdwTop As Integer, wdwHeight As Integer, wdwWidth As Integer, wdwLeft
As Integer
Public alpha As Boolean, bNoTable As Boolean, bNoChanges As Boolean,
bFileNeedsToBeSaved As Boolean, bPresNameNotChanged As Boolean
Public SlideNumberPrefix As String, TagListTabs As String, selectedTitle As
String, sNewPresName As String
Public sDocName As String
Dim IGWordDoc As Object
--------------------------
Sub AutoExec()
Dim oAddRefNumButton As CommandBarButton, oAddRefAlphaButton As
CommandBarButton, _
oNextButton As CommandBarButton, oPrevButton As CommandBarButton, _
oUpdateButton As CommandBarButton, oFormButton As CommandBarButton, _
oShowButton As CommandBarButton
Dim oCmdMenu As CommandBarControl
Dim PptRefToolbar As String


' Give the toolbar a name
PptRefToolbar = "PowerRef"

Dim oCmd As CommandBar ' Kill the existing one in case there's a new one
For Each oCmd In ActiveDocument.CommandBars
If oCmd.Name = PptRefToolbar Then
oCmd.Delete
End If
Next

Set oPptRefToolbar = CommandBars.Add(Name:=PptRefToolbar, _
Position:=msoBarTop, Temporary:=True)


' Button to add a reference
Set oAddRefAlphaButton = oPptRefToolbar.Controls.Add(Type:
=msoControlButton)
With oAddRefAlphaButton
.TooltipText = "Insert tag."
.OnAction = "InsertTag" '
.Style = msoButtonIconAndCaption
.FaceId = 25 ' symbol
End With

' Button to update
Set oUpdateButton = oPptRefToolbar.Controls.Add(Type:=msoControlButton)
With oUpdateButton
.TooltipText = "Update "
.OnAction = "Update" '
.Style = msoButtonIcon ' Button displays as icon, not
text or both
.FaceId = 280 ' symbol
End With

' Button to move to previous ref
Set oPrevButton = oPptRefToolbar.Controls.Add(Type:=msoControlButton)
With oPrevButton
.TooltipText = "Go to previous Powerpoint " + vbCr + "reference in
text"
.OnAction = "GoBackward" '
.Style = msoButtonIcon ' Button displays as icon, not
text or both
.FaceId = 185 ' Left arrow
End With

' Button to move to next ref
Set oNextButton = oPptRefToolbar.Controls.Add(Type:=msoControlButton)
With oNextButton
.TooltipText = "Go to next reference"
.OnAction = "GoFrwrd" '
.Style = msoButtonIcon ' Button displays as icon, not
text or both
.FaceId = 298 '
End With

' Button to toggle showing of field codes
Set oShowButton = oPptRefToolbar.Controls.Add(Type:=msoControlButton)
With oShowButton
.TooltipText = "Toggle showing and hiding"
.OnAction = "ToggleShow" '
.Style = msoButtonIcon ' Button displays as icon, not
text or both
.FaceId = 248 ' icon
End With

' Button to open function menu
Set oFormButton = oPptRefToolbar.Controls.Add(Type:=msoControlButton)
With oFormButton
.TooltipText = "Other functions"
.OnAction = "menuForm" '
.Style = msoButtonIcon ' Button displays as icon, not
text or both
.FaceId = 322 ' icon
End With

oPptRefToolbar.Visible = True

NormalExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
End Sub

--
Christopher Brewster
Lockheed Martin, Eagan MN

Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/word-programming/200901/1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top