I have this macro which I want to update. Problem is that there's a lot of code I don't really understand and I've taken out a lot as what I want to do is quite different from the original purpose. - First time I tried, form opened okay but now - without touching the code - I get a runtime error 424 on line frmQuotation.InitializeForm.
There's a function InitializeForm in the main code but on its own, it works perfectly fine.
The original file fill in a letterhead form and it gives one the option of up to 10 names. I've kept most of the bits with that information as it remembers the last input which means users won't need to retype their details. First time, I ran the code, this bit gave me an error but I didn't change anything as I don't really understand the code and don't even know where to begin. I'm not quite sure why the form wouldn't open the next time. I'm floored.
I've posted the code from the form window below. Any help would be really appreciated!
Code:
Private Sub cmbLTName_DropButtonClick()
numUser = cmbLTName.ListIndex + 1
ShowUser CInt(numUser)
End Sub
Private Sub cmdOk_Click()
If ValidateForm() Then
hasRecipient = False
'Insert Customer Name
Selection.GoTo What:=wdGoToBookmark, Name:="BMCustomerName"
If txtName.Text <> "" Then
Selection.TypeText Text:=txtName.Text
hasRecipient = True
Else
Selection.TypeBackspace
End If
Selection.GoTo What:=wdGoToBookmark, Name:="BMCustomerTitle"
If txtRecipientTitle.Text <> "" Then
Selection.TypeText Text:=txtRecipientTitle.Text
hasRecipient = True
Else
Selection.TypeBackspace
End If
Selection.GoTo What:=wdGoToBookmark, Name:="BMCustomerCompany"
If txtRecipientCompany.Text <> "" Then
Selection.TypeText Text:=txtRecipientCompany.Text
hasRecipient = True
Else
Selection.TypeBackspace
End If
Selection.GoTo What:=wdGoToBookmark, Name:="BMQuoteNumber"
If txtQuoteNumber.Text <> "" Then
Selection.TypeText Text:=txtQuoteNumber.Text
hasRecipient = True
Else
Selection.TypeBackspace
End If
Selection.GoTo What:=wdGoToBookmark, Name:="BMProductName"
If txtProductName.Text <> "" Then
Selection.TypeText Text:=txtProductName.Text
hasRecipient = True
Else
Selection.TypeBackspace
End If
Dim BMRange As Range
'Identify Date Bookmark range and insert text
Set BMRange = ActiveDocument.Bookmarks("BMDate").Range
BMRange.Text = txtDate.Text
'Re-insert the bookmark
ActiveDocument.Bookmarks.Add "BMDate", BMRange
'Update all Fields
Application.ScreenUpdating = False
Dim sec As Section
ActiveDocument.Fields.Update
For Each sec In ActiveDocument.Sections
sec.Headers(wdHeaderFooterPrimary).Range.Fields.Update
sec.Headers(wdHeaderFooterFirstPage).Range.Fields.Update
sec.Footers(wdHeaderFooterPrimary).Range.Fields.Update
sec.Footers(wdHeaderFooterFirstPage).Range.Fields.Update
Next
Application.ScreenUpdating = True
'Open Header
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'Insert Data into Header
Selection.GoTo What:=wdGoToBookmark, Name:="BMQuoteNumberHeader"
Selection.TypeText Text:=txtQuoteNumber.Text
'Close Header
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.GoTo What:=wdGoToBookmark, Name:="BMPreparedBy"
Selection.TypeText Text:=cmbLTName.Text & " "
Selection.GoTo What:=wdGoToBookmark, Name:="BMPreparedByTitle"
If txtLTTitleDepartment.Text <> "" Then
Selection.TypeText Text:=txtLTTitleDepartment.Text
Else
Selection.TypeBackspace
End If
Selection.GoTo What:=wdGoToBookmark, Name:="BMEMail"
If txtLTEmail.Text <> "" Then
Selection.TypeText Text:=txtLTEmail.Text
Else
Selection.TypeBackspace
Selection.Delete
End If
'Added Mobile Phone
Selection.GoTo What:=wdGoToBookmark, Name:="BMMobilePhone"
If txtLTMobile.Text <> "" Then
Selection.TypeText Text:=txtLTMobile.Text
Else
Selection.TypeBackspace
Selection.Delete
End If
numofname = GetNumberOfName(cmbLTName.Text)
If numofname = 0 Then
numofname = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0")) + 1
SaveSetting "GETemplates", "UserInfo", "numNames", CStr(numofname)
End If
SaveSetting "GETemplates", "LetterheadName" & CStr(numofname), "Name", cmbLTName.Text
SaveSetting "GETemplates", "LetterheadName" & CStr(numofname), "Titles", txtLTTitleDepartment.Text
SaveSetting "GETemplates", "LetterheadName" & CStr(numofname), "Mobile", txtLTMobile.Text
SaveSetting "GETemplates", "LetterheadName" & CStr(numofname), "Email", txtLTEmail.Text
SaveSetting "GETemplates", "UserInfo", "LastNumUsed", CStr(numofname)
End If
Selection.GoTo What:=wdGoToBookmark, Name:="Body"
Me.Hide
End Sub
Private Sub cmdRemove_Click()
numUser = cmbLTName.ListIndex + 1
If numUser <> 0 Then
numnames = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0"))
DeleteSetting "GETemplates", "LetterheadName" & CStr(numUser)
For x = numUser + 1 To numnames
tempName = GetSetting("GETemplates", "LetterheadName" & CStr(x), "Name", "")
tempTitles = GetSetting("GETemplates", "LetterheadName" & CStr(x), "Titles", "")
tempEmail = GetSetting("GETemplates", "LetterheadName" & CStr(x), "Email", "")
tempFax = GetSetting("GETemplates", "LetterheadName" & CStr(x), "Fax", "")
SaveSetting "GETemplates", "LetterheadName" & CStr(x - 1), "Name", tempName
SaveSetting "GETemplates", "LetterheadName" & CStr(x - 1), "Titles", tempTitle
SaveSetting "GETemplates", "LetterheadName" & CStr(x - 1), "Email", tempEmail
SaveSetting "GETemplates", "LetterheadName" & CStr(x - 1), "Fax", tempFax
Next
If numUser <> numnames Then
DeleteSetting "GETemplates", "LetterheadName" & CStr(numnames)
End If
SaveSetting "GETemplates", "UserInfo", "numNames", CStr(numnames - 1)
cmbLTName.RemoveItem numUser - 1
If numnames - 1 <> 0 Then
cmbLTName.ListIndex = 0
Else
cmbLTName.Text = ""
End If
ShowUser 1
SaveSetting "GETemplates", "UserInfo", "LastNumUsed", CStr(1)
End If
End Sub
Private Sub txtCancel_Click()
Me.Hide
End Sub
Public Sub InitializeForm()
ClearFormElements
If GetSetting("GETemplates", "UserInfo", "LastNumUsed", "1") = "" Then lastused = "1" Else: lastused = GetSetting("GETemplates", "UserInfo", "LastNumUsed", "1")
LastNumUsed = CInt(lastused)
'sender specific
cmbLTName.Text = GetSetting("GETemplates", "LetterheadName" & CStr(LastNumUsed), "Name", "")
txtLTTitleDepartment.Text = GetSetting("GETemplates", "LetterheadName" & CStr(LastNumUsed), "Titles", "")
txtLTMobile.Text = GetSetting("GETemplates", "LetterheadName" & CStr(LastNumUsed), "Mobile", "")
txtLTEmail.Text = GetSetting("GETemplates", "LetterheadName" & CStr(LastNumUsed), "Email", "")
strdate = Format(Date, "d mmmm yyyy")
txtDate.Text = strdate
numnames = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0"))
cmbLTName.Clear
For x = 1 To numnames
cmbLTName.AddItem GetSetting("GETemplates", "LetterheadName" & CStr(x), "Name", "")
Next
End Sub
Private Sub txtlttitledepartment_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
If txtLTTitleDepartment.LineCount >= 2 Then
WordBasic.SendKeys "{BACKSPACE}"
End If
End If
End Sub
Private Sub txtSolutionPlatform_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
If txtSolutionPlatform.LineCount >= 2 Then
WordBasic.SendKeys "{BACKSPACE}"
End If
End If
End Sub
Private Function GetNumberOfName(vName As String) As Integer
vInt = 0
numnames = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0"))
For x = 1 To numnames
tempName = GetSetting("GETemplates", "LetterheadName" & CStr(x), "Name", "")
If Trim(tempName) = Trim(vName) Then
vInt = x
End If
Next
GetNumberOfName = vInt
End Function
Private Sub ShowUser(numUser As Integer)
txtLTEmail.Text = GetSetting("GETemplates", "LetterheadName" & CStr(numUser), "Email", "")
txtLTMobile.Text = GetSetting("GETemplates", "LetterheadName" & CStr(numUser), "Mobile", "")
End Sub
Function SearchAndReplace(s As String, Str1 As Variant, Str2 As Variant) As String
Dim pos
s = s & "" 'Fix Null
pos = InStr(s, Str1)
While pos > 0
s = Mid(s, 1, pos - 1) & Str2 & Mid(s, pos + Len(Str1))
pos = InStr(pos + Len(Str2), s, Str1)
Wend
SearchAndReplace = s
End Function
Sub ClearFormElements()
txtName.Text = ""
txtRecipientTitle.Text = ""
txtAddress.Text = ""
End Sub
Function ValidateForm() As Boolean
numnames = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0"))
If numnames = 10 And GetNumberOfName(cmbLTName.Text) = 0 Then
MsgBox "You can store up to ten names. Please remove a name before adding another.", vbExclamation, "frmQuotation"
ValidateForm = False
Exit Function
End If
If Trim(cmbLTName.Text) = "" Then
MsgBox "Please enter a Sender name", vbExclamation, "frmQuotation"
cmbLTName.SetFocus
ValidateForm = False
Exit Function
End If
ValidateForm = True
End Function
Private Sub cmbLTName_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode.Value <= 90 And KeyCode.Value >= 48 Then
numnames = CInt(GetSetting("GETemplates", "UserInfo", "numNames", "0"))
If numnames = 10 Then
MsgBox "You can store up to ten names. Please remove a name before adding another.", vbExclamation, "frmQuotation"
End If
End If
End Sub