brooke48
12-09-2010, 06:57 AM
I have a Useform containing textboxes and option buttons which opens when a Word document is opened and I have two problems - first, if a textbox is left blank, a message appears asking for it to be completed. When this message is acknowledged, the Userform does not reappear to allow for the textbox to be completed - the Word doc appears. Second, when the Userform has been completed, and "OK" is clicked, none of the DocVariable fields in the Word doc are updated.
My code is:
Option Explicit
Public boolProceed As Boolean
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButton3_Click()
End Sub
Private Sub cmdCancel_Click()
Unload Me
ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdClearForm_Click()
optStatus1.Value = True
TextBox1.Value = Null
TextBox2.Value = Null
TextBox3.Value = Null
TextBox4.Value = Null
TextBox5.Value = Null
TextBox6.Value = Null
TextBox7.Value = Null
TextBox8.Value = Null
TextBox9.Value = Null
TextBox10.Value = Null
TextBox11.Value = Null
TextBox12.Value = Null
TextBox13.Value = Null
TextBox14.Value = Null
TextBox15.Value = Null
TextBox16.Value = Null
TextBox17.Value = Null
TextBox18.Value = Null
TextBox19.Value = Null
End Sub
Private Sub cmdOK_Click()
Me.Hide
Dim boolComplete As Boolean
Dim oVars As Variables
Set oVars = ActiveDocument.Variables
'Update the fields in the document
ActiveDocument.Fields.Update
Select Case ""
Case Me.TextBox1.Value
MsgBox "Please type your full name."
Me.TextBox1.SetFocus
Exit Sub
Case Me.TextBox2.Value
MsgBox "Please type your institution."
Me.TextBox2.SetFocus
Exit Sub
Case Me.TextBox5.Value
MsgBox "Please fill-in your address."
Me.TextBox5.SetFocus
Exit Sub
Case Me.TextBox3.Value
MsgBox "Please fill-in your phone number."
Me.TextBox3.SetFocus
Exit Sub
Case Me.TextBox4.Value
MsgBox "Please type your email address."
Me.TextBox4.SetFocus
Exit Sub
End Select
Me.boolProceed = True
Me.Hide
Dim strFrame1 As String
Dim strFrame2 As String
Dim strSubmissionType As String
Dim ctl As Control
If optStatus1 = True Then strFrame1 = "Research Student"
If optStatus2 = True Then strFrame1 = "Academic Staff Member"
If optStatus3 = True Then strFrame1 = "Practising Staff Member"
If optStatus4 = True Then strFrame1 = "Independent"
If optStatus5 = True Then strFrame1 = "Other"
If optAll = True Then strFrame2 = "All"
If optPrimary = True Then strFrame2 = "Primary"
If optSecondary = True Then strFrame2 = "Secondary"
If optFE = True Then strFrame2 = "FE"
If optHE = True Then strFrame2 = "HE"
If optResearcher = True Then strFrame2 = "Researcher"
If optOther = True Then strFrame2 = "Other (please specify)"
If optType1 = True Then strSubmissionType = "Paper"
If optType2 = True Then strSubmissionType = "Workshop"
If optType3 = True Then strSubmissionType = "Poster Session"
If optType4 = True Then strSubmissionType = "Other (please specify)"
boolComplete = True
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox1"
Case "TextBox2"
Case "TextBox3"
Case "TextBox4"
Case "TextBox5"
Case "TextBox6"
Case "TextBox7"
Case "TextBox8"
Case "TextBox8"
Case "TextBox9"
Case "TextBox10"
Case "TextBox11"
Case "TextBox12"
Case "TextBox13"
Case "TextBox14"
Case "TextBox15"
Case "TextBox16"
Case "TextBox17"
Case "TextBox18"
Case "TextBox19"
If ctl.Value = "" Then
boolComplete = False
ctl.BackColor = vbRed
Else
ctl.BackColor = &H80000005
End If
End Select
Next ctl
MsgBox "You have not completed the form" & vbCrLf & vbCrLf & "Please fill in the highlighted boxes", vbExclamation, "Incomplete"
Call myUpdateFields
Application.ScreenUpdating = False
Unload Me
End Sub
Private Sub OptionButton3_Click()
End Sub
Private Sub OptionButton4_Click()
End Sub
Private Sub UserForm_Initialize()
optStatus1.Value = True
End Sub
Sub CallUF()
Dim oFrm As frmPresenterSubmission
Dim oVars As Word.Variables
Dim pStr As String
Dim oRng As Word.Range
Dim i As Long
Dim pMulSel As String
Dim boolProceed As Boolean
Set oVars = ActiveDocument.Variables
Set oFrm = New frmPresenterSubmission
With oFrm
.Show
If boolProceed Then
oVars("varName").Value = TextBox1
oVars("varInstitution").Value = TextBox2
oVars("varPhone").Value = TextBox3
oVars("varEmail").Value = TextBox4
oVars("varAddress").Value = TextBox5
'Replace the line breaks entered by the user with line breaks and tabs_to ensure address entry is properly indented.
pStr = Replace(TextBox5.Value, Chr(10), Chr(10) + Chr(9))
Set oRng = ActiveDocument.Bookmarks("bmAddress").Range
oRng.Text = pStr
ActiveDocument.Bookmarks.Add "bmAddress", oRng
End If
If .CheckBox1.Value = True Then pStr = "Yes,"
If .CheckBox2.Value = True Then pStr = "No,"
If .CheckBox3.Value = True Then pStr = "Yes,"
If .CheckBox4.Value = True Then pStr = "No,"
End With
Unload oFrm
Set oFrm = Nothing
Set oVars = Nothing
Set oRng = Nothing
End Sub
Sub myUpdateFields()
Dim pRange As Word.Range
Dim iLink As Long
For Each pRange In ActiveDocument.StoryRanges
Do
pRange.Fields.Update
Set pRange = pRange.NextStoryRange
Loop Until pRange Is Nothing
Next
End Sub
I'm sure this code needs cleaning up as well as resolving the 2 issues above. Any guidance much appreciated.
My code is:
Option Explicit
Public boolProceed As Boolean
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButton3_Click()
End Sub
Private Sub cmdCancel_Click()
Unload Me
ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdClearForm_Click()
optStatus1.Value = True
TextBox1.Value = Null
TextBox2.Value = Null
TextBox3.Value = Null
TextBox4.Value = Null
TextBox5.Value = Null
TextBox6.Value = Null
TextBox7.Value = Null
TextBox8.Value = Null
TextBox9.Value = Null
TextBox10.Value = Null
TextBox11.Value = Null
TextBox12.Value = Null
TextBox13.Value = Null
TextBox14.Value = Null
TextBox15.Value = Null
TextBox16.Value = Null
TextBox17.Value = Null
TextBox18.Value = Null
TextBox19.Value = Null
End Sub
Private Sub cmdOK_Click()
Me.Hide
Dim boolComplete As Boolean
Dim oVars As Variables
Set oVars = ActiveDocument.Variables
'Update the fields in the document
ActiveDocument.Fields.Update
Select Case ""
Case Me.TextBox1.Value
MsgBox "Please type your full name."
Me.TextBox1.SetFocus
Exit Sub
Case Me.TextBox2.Value
MsgBox "Please type your institution."
Me.TextBox2.SetFocus
Exit Sub
Case Me.TextBox5.Value
MsgBox "Please fill-in your address."
Me.TextBox5.SetFocus
Exit Sub
Case Me.TextBox3.Value
MsgBox "Please fill-in your phone number."
Me.TextBox3.SetFocus
Exit Sub
Case Me.TextBox4.Value
MsgBox "Please type your email address."
Me.TextBox4.SetFocus
Exit Sub
End Select
Me.boolProceed = True
Me.Hide
Dim strFrame1 As String
Dim strFrame2 As String
Dim strSubmissionType As String
Dim ctl As Control
If optStatus1 = True Then strFrame1 = "Research Student"
If optStatus2 = True Then strFrame1 = "Academic Staff Member"
If optStatus3 = True Then strFrame1 = "Practising Staff Member"
If optStatus4 = True Then strFrame1 = "Independent"
If optStatus5 = True Then strFrame1 = "Other"
If optAll = True Then strFrame2 = "All"
If optPrimary = True Then strFrame2 = "Primary"
If optSecondary = True Then strFrame2 = "Secondary"
If optFE = True Then strFrame2 = "FE"
If optHE = True Then strFrame2 = "HE"
If optResearcher = True Then strFrame2 = "Researcher"
If optOther = True Then strFrame2 = "Other (please specify)"
If optType1 = True Then strSubmissionType = "Paper"
If optType2 = True Then strSubmissionType = "Workshop"
If optType3 = True Then strSubmissionType = "Poster Session"
If optType4 = True Then strSubmissionType = "Other (please specify)"
boolComplete = True
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox1"
Case "TextBox2"
Case "TextBox3"
Case "TextBox4"
Case "TextBox5"
Case "TextBox6"
Case "TextBox7"
Case "TextBox8"
Case "TextBox8"
Case "TextBox9"
Case "TextBox10"
Case "TextBox11"
Case "TextBox12"
Case "TextBox13"
Case "TextBox14"
Case "TextBox15"
Case "TextBox16"
Case "TextBox17"
Case "TextBox18"
Case "TextBox19"
If ctl.Value = "" Then
boolComplete = False
ctl.BackColor = vbRed
Else
ctl.BackColor = &H80000005
End If
End Select
Next ctl
MsgBox "You have not completed the form" & vbCrLf & vbCrLf & "Please fill in the highlighted boxes", vbExclamation, "Incomplete"
Call myUpdateFields
Application.ScreenUpdating = False
Unload Me
End Sub
Private Sub OptionButton3_Click()
End Sub
Private Sub OptionButton4_Click()
End Sub
Private Sub UserForm_Initialize()
optStatus1.Value = True
End Sub
Sub CallUF()
Dim oFrm As frmPresenterSubmission
Dim oVars As Word.Variables
Dim pStr As String
Dim oRng As Word.Range
Dim i As Long
Dim pMulSel As String
Dim boolProceed As Boolean
Set oVars = ActiveDocument.Variables
Set oFrm = New frmPresenterSubmission
With oFrm
.Show
If boolProceed Then
oVars("varName").Value = TextBox1
oVars("varInstitution").Value = TextBox2
oVars("varPhone").Value = TextBox3
oVars("varEmail").Value = TextBox4
oVars("varAddress").Value = TextBox5
'Replace the line breaks entered by the user with line breaks and tabs_to ensure address entry is properly indented.
pStr = Replace(TextBox5.Value, Chr(10), Chr(10) + Chr(9))
Set oRng = ActiveDocument.Bookmarks("bmAddress").Range
oRng.Text = pStr
ActiveDocument.Bookmarks.Add "bmAddress", oRng
End If
If .CheckBox1.Value = True Then pStr = "Yes,"
If .CheckBox2.Value = True Then pStr = "No,"
If .CheckBox3.Value = True Then pStr = "Yes,"
If .CheckBox4.Value = True Then pStr = "No,"
End With
Unload oFrm
Set oFrm = Nothing
Set oVars = Nothing
Set oRng = Nothing
End Sub
Sub myUpdateFields()
Dim pRange As Word.Range
Dim iLink As Long
For Each pRange In ActiveDocument.StoryRanges
Do
pRange.Fields.Update
Set pRange = pRange.NextStoryRange
Loop Until pRange Is Nothing
Next
End Sub
I'm sure this code needs cleaning up as well as resolving the 2 issues above. Any guidance much appreciated.