OTWarrior
12-06-2007, 04:13 AM
This is actually from my first post in the KB, but I have been going through the code in order to speed it up. any ideas would be much appreciated (although I have made some amendments already, if it can be made faster it would be great)
The purpose of this code is to clear a formfield dropdown list when a certain value is chosen, and to repopulate the list with values from an array. The dropdown menu is then automatically brought down (to show the new list) and will not let you leave the drop down menu until a valid option is chosen.
here is the code for the whole process:
Public Sub BOnEntry()
Set HighlightSettings = Selection.Range
With Selection
If .FormFields.Count = 1 Then
'No textbox but a check- or listbox
BKMName = .FormFields(1).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
ElseIf .FormFields.Count = 0 And .Bookmarks.Count > 0 Then
BKMName = .Bookmarks(.Bookmarks.Count).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
Else
MsgBox "System Error ~ Please re-select a dropdown menu", 64
End If
End With
ResultCheck = ffSelect.Result
Call ffGeneratorService
Exit Sub
End Sub
Public Function ffGeneratorService()
On Error GoTo ErrerHandel
Set ffSelect = ActiveDocument.FormFields(BKMName)
Set ffSelectDropdown = ActiveDocument.FormFields(BKMName).DropDown
Set ffSelectList = ActiveDocument.FormFields(BKMName).DropDown.ListEntries
nGenCount = False
'service list 1 - 21 items
Data = Array("random data", "..Next Service List...")
'Service list 2 - 23 items
Data2 = Array("random data", "...Previous Service List")
'
With ffSelect
If .Result = "Select a Service" Then
Call unHighlighter
Exit Function
ElseIf .Result = "..Next Service List..." Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i2 = LBound(Data2) To UBound(Data2)
.Add Data2(i2)
Next i2
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
ElseIf .Result = "...Previous Service List" Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i = LBound(Data) To UBound(Data)
.Add Data(i)
Next i
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
Else
nGenCount = False
'Application.ScreenUpdating = True
Call unHighlighter
End If
End With
'
Exit Function
ErrerHandel:
MsgBox Err.Description, 64, Err.Number
Exit Function
End Function
Public Sub AOnExit()
Set ffSelect = ActiveDocument.FormFields(BKMName)
If nGenCount = True Then
Call Highlighter
Exit Sub
Else
Select Case ffSelect.Result
Case "...Previous Service List"
Call ffGeneratorService
Case "..Next Service List..."
Call ffGeneratorService
Case Else
Call unHighlighter
End Select
End If
End Sub
Public Function Highlighter()
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdYellow
unHighlighted = False
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function
Public Function unHighlighter()
If unHighlighted = True Then Exit Function
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdNoHighlight
unHighlighted = True
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function
NB: the code works fully, I just want to make it faster
Thanks in advance.
The purpose of this code is to clear a formfield dropdown list when a certain value is chosen, and to repopulate the list with values from an array. The dropdown menu is then automatically brought down (to show the new list) and will not let you leave the drop down menu until a valid option is chosen.
here is the code for the whole process:
Public Sub BOnEntry()
Set HighlightSettings = Selection.Range
With Selection
If .FormFields.Count = 1 Then
'No textbox but a check- or listbox
BKMName = .FormFields(1).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
ElseIf .FormFields.Count = 0 And .Bookmarks.Count > 0 Then
BKMName = .Bookmarks(.Bookmarks.Count).Name
ResultCheck = ActiveDocument.FormFields(BKMName).Result
Call ffGeneratorService
Exit Sub
Else
MsgBox "System Error ~ Please re-select a dropdown menu", 64
End If
End With
ResultCheck = ffSelect.Result
Call ffGeneratorService
Exit Sub
End Sub
Public Function ffGeneratorService()
On Error GoTo ErrerHandel
Set ffSelect = ActiveDocument.FormFields(BKMName)
Set ffSelectDropdown = ActiveDocument.FormFields(BKMName).DropDown
Set ffSelectList = ActiveDocument.FormFields(BKMName).DropDown.ListEntries
nGenCount = False
'service list 1 - 21 items
Data = Array("random data", "..Next Service List...")
'Service list 2 - 23 items
Data2 = Array("random data", "...Previous Service List")
'
With ffSelect
If .Result = "Select a Service" Then
Call unHighlighter
Exit Function
ElseIf .Result = "..Next Service List..." Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i2 = LBound(Data2) To UBound(Data2)
.Add Data2(i2)
Next i2
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
ElseIf .Result = "...Previous Service List" Then
.Select
With ffSelectList
.Clear
.Add "Select a Service"
'Application.DisplayStatusBar = True
'Application.StatusBar = "Please wait while Word rebuild the dropdown list..."
For i = LBound(Data) To UBound(Data)
.Add Data(i)
Next i
End With
ffSelectDropdown.Value = 1
nGenCount = True
'Application.DisplayStatusBar = False
Call Highlighter
DoEvents
SendKeys "%({DOWN})", True
Call ffGeneratorService
Else
nGenCount = False
'Application.ScreenUpdating = True
Call unHighlighter
End If
End With
'
Exit Function
ErrerHandel:
MsgBox Err.Description, 64, Err.Number
Exit Function
End Function
Public Sub AOnExit()
Set ffSelect = ActiveDocument.FormFields(BKMName)
If nGenCount = True Then
Call Highlighter
Exit Sub
Else
Select Case ffSelect.Result
Case "...Previous Service List"
Call ffGeneratorService
Case "..Next Service List..."
Call ffGeneratorService
Case Else
Call unHighlighter
End Select
End If
End Sub
Public Function Highlighter()
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdYellow
unHighlighted = False
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function
Public Function unHighlighter()
If unHighlighted = True Then Exit Function
With ActiveDocument
If .ProtectionType <> wdNoProtection Then
.Unprotect Password:=""
End If
HighlightSettings.HighlightColorIndex = wdNoHighlight
unHighlighted = True
If .ProtectionType = wdNoProtection Then
.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End With
'Application.ScreenUpdating = True
End Function
NB: the code works fully, I just want to make it faster
Thanks in advance.