Runtime error on Initialise Form

Amapola188 · #1 05-29-2012, 09:16 PM

Good Afternoon
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.

Code:

 
Sub AutoNew()
    
    'Denote that this form is being run for the very first time for this document
    Load frmQuotation
    'Show the form to prompt the user for info
    frmQuotation.InitializeForm
    frmQuotation.Show
End Sub

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!

Christine

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

macropod · #2 06-05-2012, 11:40 AM

The 424 error suggests your document does not have a sub named 'InitializeForm' in a userform named 'frmQuotation'.

You would be well advised to spend some time learning how vba works before you try to tackle revising someone else's project with ~270 lines of code and a userform, all tied into a specific document structure.

Amapola188 · #3 06-05-2012, 12:50 PM

Thanks, Paul.

That would be nice, wouldn't it? However, in my job I'm just expected to cope with whatever people throw at me.

I understand that bit of the code which is why I don't understand why it doesn't work. As you say, the error says it's not there but it is! And it's public so I see absolutely no reason why it can't find it.

Christine

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
runtime error 1004	gbaker	Excel Programming	11	06-06-2012 05:23 AM
Runtime Error 4120 in Word 2007 macro	Frankwlc	Word	5	11-28-2011 01:54 AM
Runtime error 91	waldux	Word VBA	1	03-04-2011 11:25 PM
Runtime error 5487 - Word cannot complete the save to to file permission error	franferns	Word	0	11-25-2009 05:35 AM
Receive error cannot open this form because an error occurred in BCM 2007	bornhusker	Outlook	0	06-01-2009 10:28 AM