Jonas Offersen

New Member
Joined
Feb 13, 2018
Messages
14
Hello again everyone!

I'm getting this error the second time I click the button, to which this code is assigned. I suspect I'm not referring properly to the word or excel objects, but I'm not sure where I'm going wrong. Could I please convince someone to look through this rather large piece of code and tell me if you can see the error? (I've been staring myself blind on it for the past few days... :eek:)

Code:
[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////               Check if Case Exist              //////////
'////////////////////////////////////////////////////////////////////
[/COLOR]    Dim sh As Worksheet
    Dim rw As Range
    Dim exist As Boolean
    Set sh = Ark2
    
    For Each rw In sh.Rows
        If sh.Cells(rw.Row, 1).value = FormNewIBooking.TextBoxSNR.value Then
            exist = True
            Exit For
        Else
            exist = False
        End If
    Next rw

[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////                 Populate Excel                 //////////
'////////////////////////////////////////////////////////////////////
[/COLOR]    
If exist And GlobalVariables.StarIBooking Then
    MsgBox "Bookingnummeret findes allerede i databasen, hvis du er ved at oprette en ny booking, så find et andet bookingnummer, ellers åben den allerede eksisterende booking."
Else

    Dim ipos As Range
    If StarIBooking Then
        For Each rw In sh.Rows
            If sh.Cells(rw.Row, 1).value = "" Then
                Set ipos = sh.Cells(rw.Row, 1)
                Exit For
            End If
        Next rw
    Else
        For Each rw In sh.Rows
            If sh.Cells(rw.Row, 1).value = FormNewIBooking.TextBoxSNR.value Then
                Set ipos = sh.Cells(rw.Row, 1)
                Exit For
            End If
        Next rw
    End If
    
    ipos.Offset(, 0) = FormNewIBooking.TextBoxSNR.value          [COLOR=#00ff00]'Sagsnummer
[/COLOR]    ipos.Offset(, 1) = FormNewIBooking.TextBoxUF.value           [COLOR=#00ff00]'Undervisningsforløb
[/COLOR]    ipos.Offset(, 2) = FormNewIBooking.TextBoxDate.value         [COLOR=#00ff00]'Dato[/COLOR]
    ipos.Offset(, 3) = FormNewIBooking.TextBoxTime.value         [COLOR=#00ff00]'Tidspunkt[/COLOR]
    ipos.Offset(, 4) = FormNewIBooking.TextBoxAdults.value       [COLOR=#00ff00]'Antal Voksne[/COLOR]
    ipos.Offset(, 5) = FormNewIBooking.TextBoxChildren.value     [COLOR=#00ff00]'Antal Børn[/COLOR]
    ipos.Offset(, 6) = FormNewIBooking.TextBoxSI.value           [COLOR=#00ff00]'Skole/Institution[/COLOR]
    ipos.Offset(, 7) = FormNewIBooking.TextBoxPayment.value     [COLOR=#00ff00] 'Betalingsform[/COLOR]
    ipos.Offset(, 8) = FormNewIBooking.TextBoxClass.value     [COLOR=#00ff00]  'Klasse[/COLOR]
    ipos.Offset(, 9) = FormNewIBooking.TextBoxLastName.value   [COLOR=#00ff00] 'Efternavn[/COLOR]
    ipos.Offset(, 10) = FormNewIBooking.TextBoxFirstName.value  [COLOR=#00ff00]'Fornavn[/COLOR]
    ipos.Offset(, 11) = FormNewIBooking.TextBoxIAdress.value    [COLOR=#00ff00]'Skole/Institutions adresse[/COLOR]
    ipos.Offset(, 12) = FormNewIBooking.TextBoxPNR.value        [COLOR=#00ff00]'Post Nummer[/COLOR]
    ipos.Offset(, 13) = FormNewIBooking.TextBoxCity.value       [COLOR=#00ff00]'By[/COLOR]
    ipos.Offset(, 14) = FormNewIBooking.TextBoxPhone.value     [COLOR=#00ff00] 'Telefon nummer[/COLOR]
    ipos.Offset(, 15) = FormNewIBooking.TextBoxEMail.value     [COLOR=#00ff00] 'Emailadresse
[/COLOR]
[COLOR=#00ff00]'//////////     antal
[/COLOR]    Dim items As String
    If (FormNewIBooking.ListBoxAntal.ListCount <> 0) Then
        For Each Item In FormNewIBooking.ListBoxAntal.List
            If (Item <> "") Then
                If (items = "") Then
                    items = CStr(Item)
                Else
                    items = items + ", " + CStr(Item)
                End If
            End If
        Next
    End If
    ipos.Offset(, 16) = items
    
[COLOR=#00ff00]'//////////     Aktivitet
[/COLOR]    items = ""
    If (FormNewIBooking.ActivityList.ListCount <> 0) Then
        For Each Item In FormNewIBooking.ActivityList.List
            If (Item <> "") Then
                If (items = "") Then
                    items = Item
                Else
                    items = items + ", " + CStr(Item)
                End If
            End If
        Next
    End If
    ipos.Offset(, 17) = items
    
[COLOR=#00ff00]'//////////     Stk Pris
[/COLOR]    items = ""
    If (FormNewIBooking.ListBoxStkPrice.ListCount <> 0) Then
        For Each Item In FormNewIBooking.ListBoxStkPrice.List
            If (Item <> "") Then
                If (items = "") Then
                    items = CStr(Item)
                Else
                    items = items + ", " + CStr(Item)
                End If
            End If
        Next
    End If
    ipos.Offset(, 18) = items
    
[COLOR=#00ff00]'//////////     Samlet Aktivitets Pris
[/COLOR]    items = ""
    If (FormNewIBooking.ListBoxTotalPrice.ListCount <> 0) Then
        For Each Item In FormNewIBooking.ListBoxTotalPrice.List
            If (Item <> "") Then
                If (items = "") Then
                    items = CStr(Item)
                Else
                    items = items + ", " + CStr(Item)
                End If
            End If
        Next
    End If
    ipos.Offset(, 19) = items

    ipos.Offset(, 20) = FormNewIBooking.TextBoxPrice.value       [COLOR=#00ff00]'Samet pris[/COLOR]
    ipos.Offset(, 21) = FormNewIBooking.TextBoxNotes.value      [COLOR=#00ff00] 'Noter[/COLOR]
    
[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////                Initiate MS Word                //////////
'////////////////////////////////////////////////////////////////////
[/COLOR]    
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim tableNew As Word.Table
    
    If Not (objWord Is Nothing) Then
        objWord.Quit
        Set objWord = Nothing
        If Not (objDoc Is Nothing) Then
            objDoc.Close
            If Not (tableNew Is Nothing) Then
                Set tableNew = Nothing
            End If
        End If
    End If
    
    Set objWord = New Word.Application
    Set objDoc = objWord.Documents.Open(Application.ActiveWorkbook.Path & "/Skabeloner/Brevparpir.docx")
    
    objWord.Visible = True
    Set objselection = objWord.Selection
    
    objselection.Font.Name = "calibri"
    objselection.Font.Size = 11
    objselection.ParagraphFormat.SpaceAfter = 0
        
    objDoc.Activate
    Set myrange = objDoc.Range
    objDoc.Tables.Add myrange, 6, 2
    Set tableNew = objDoc.Tables(1)
    
    Dim uBold As Integer
    Dim temp As Integer
    
[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////             Modify Table Aperance              //////////
'////////////////////////////////////////////////////////////////////
[/COLOR]            
    With tableNew
[COLOR=#00ff00]'//////////     Merge and split rows
[/COLOR]        .Cell(2, 1).Merge mergeto:=.Cell(Row:=2, Column:=2)
        .Cell(3, 1).Merge mergeto:=.Cell(Row:=3, Column:=2)
        .Cell(3, 1).Split NumRows:=1, NumColumns:=4
        .Cell(4, 1).Merge mergeto:=.Cell(Row:=4, Column:=2)
        .Cell(4, 1).Split NumRows:=1, NumColumns:=4
        .Cell(6, 1).Merge mergeto:=.Cell(Row:=6, Column:=2)

[COLOR=#00ff00]'//////////     set borders
[/COLOR]        .Rows(2).Borders(wdBorderTop).LineStyle = wdLineStyleDouble
        .Rows(3).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
        .Rows(3).Borders(wdBorderTop).LineStyle = wdLineStyleDouble
        .Rows(5).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
        .Rows(5).Borders(wdBorderTop).LineStyle = wdLineStyleDouble
        
[COLOR=#00ff00]'//////////     set cell widths
[/COLOR]        .Cell(3, 1).SetWidth ColumnWidth:=InchesToPoints(0.49), rulerstyle:=wdAdjustNone[COLOR=#0000ff] 'This is where the error happens[/COLOR]
        .Cell(3, 2).SetWidth ColumnWidth:=InchesToPoints(4.3), rulerstyle:=wdAdjustNone
        .Cell(3, 3).SetWidth ColumnWidth:=InchesToPoints(1), rulerstyle:=wdAdjustNone
        .Cell(3, 4).SetWidth ColumnWidth:=InchesToPoints(1), rulerstyle:=wdAdjustNone
        .Cell(4, 1).SetWidth ColumnWidth:=InchesToPoints(0.49), rulerstyle:=wdAdjustNone
        .Cell(4, 2).SetWidth ColumnWidth:=InchesToPoints(4.3), rulerstyle:=wdAdjustNone
        .Cell(4, 3).SetWidth ColumnWidth:=InchesToPoints(1), rulerstyle:=wdAdjustNone
        .Cell(4, 4).SetWidth ColumnWidth:=InchesToPoints(1), rulerstyle:=wdAdjustNone
        .Cell(5, 1).SetWidth ColumnWidth:=InchesToPoints(5.79), rulerstyle:=wdAdjustNone
        .Cell(5, 2).SetWidth ColumnWidth:=InchesToPoints(1), rulerstyle:=wdAdjustNone
        
[COLOR=#00ff00]'//////////     Set Paragraph Alignments
[/COLOR]        .Cell(3, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        .Cell(3, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        .Cell(4, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        .Cell(4, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        .Cell(5, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            
            
[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////               Populate the table               //////////
'////////////////////////////////////////////////////////////////////

'//////////     Populate first cell of first row
[/COLOR]            
            With .Cell(1, 1).Range
                .InsertAfter FormNewIBooking.TextBoxSI.value & ", " & FormNewIBooking.TextBoxClass.value & vbNewLine
                .InsertAfter FormNewIBooking.TextBoxFirstName.value & " " & FormNewIBooking.TextBoxLastName.value & vbNewLine
                .InsertAfter FormNewIBooking.TextBoxIAdress & vbNewLine
                .InsertAfter FormNewIBooking.TextBoxPNR.value & " " & FormNewIBooking.TextBoxCity.value & vbNewLine
            End With

[COLOR=#00ff00]'//////////     Populate second cell of first row
[/COLOR]            
            With .Cell(1, 2).Range
                temp = 0
                '.InsertAfter GlobalConstants.iDate
                'uBold = Len(GlobalConstants.iDate)
                'For iBold = 1 To uBold
                '    .Characters(iBold).Font.Bold = wdToggle
                'Next iBold
                '.InsertAfter FormNewIBooking.TextBoxDate.Value & vbNewLine
                'For iBold = uBold To Len(FormNewIBooking.TextBoxDate.Value) + uBold
                '    .Characters(iBold).Font.Bold = False
                'Next iBold
                'temp = Len(FormNewIBooking.TextBoxDate.Value) + uBold
                
                '.InsertAfter GlobalConstants.iTime
                'uBold = Len(GlobalConstants.iTime) + temp
                'For iBold = temp + 1 To uBold
                '    .Characters(iBold).Font.Bold = wdToggle
                'Next iBold
                '.InsertAfter FormNewIBooking.TextBoxTime.Value & vbNewLine
                'For iBold = uBold To Len(FormNewIBooking.TextBoxTime.Value) + uBold
                '    .Characters(iBold).Font.Bold = False
                'Next iBold
                'temp = Len(FormNewIBooking.TextBoxTime.Value) + uBold + 1
                
                .InsertAfter GlobalConstants.iSNR
                uBold = Len(GlobalConstants.iSNR) ' + temp
                For iBold = temp + 1 To uBold
                    .Characters(iBold).Font.Bold = wdToggle
                Next iBold
                .InsertAfter FormNewIBooking.TextBoxSNR.value & vbNewLine
                For iBold = uBold To Len(FormNewIBooking.TextBoxSNR.value) + uBold
                    .Characters(iBold).Font.Bold = False
                Next iBold
                temp = Len(FormNewIBooking.TextBoxSNR.value) + uBold + 1
                
                .InsertAfter GlobalConstants.iPayment
                uBold = Len(GlobalConstants.iPayment) + temp
                For iBold = temp + 1 To uBold
                    .Characters(iBold).Font.Bold = wdToggle
                Next iBold
                .InsertAfter FormNewIBooking.TextBoxPayment.value & vbNewLine
                For iBold = uBold To Len(FormNewIBooking.TextBoxPayment.value) + uBold
                    .Characters(iBold).Font.Bold = False
                Next iBold
            End With
            [COLOR=#00ff00]
'//////////     Populate second row[/COLOR]
            
            With .Cell(2, 1).Range
                .InsertAfter vbNewLine
                .InsertAfter "Kære " & FormNewIBooking.TextBoxFirstName & " " & FormNewIBooking.TextBoxLastName & vbNewLine & vbNewLine
                .InsertAfter "Tak for jeres booking. Det bekræftes hermed at" _
                & " " & FormNewIBooking.TextBoxSI.value & "deltager i følgende undervisningsforløb: " _
                & FormNewIBooking.TextBoxUF & ", " & "med " & FormNewIBooking.TextBoxAdults.value & " voksne og " & FormNewIBooking.TextBoxChildren.value & " børn." & vbNewLine
            End With
            
[COLOR=#00ff00]'//////////     Populate third row
[/COLOR]            
            With .Cell(3, 1).Range
                .Font.Bold = True
                .InsertAfter "Antal"
            End With
            With .Cell(3, 2).Range
                .Font.Bold = True
                .InsertAfter "Aktiviteter den " & _
                CStr(Left(FormNewIBooking.TextBoxDate.value, InStr(FormNewIBooking.TextBoxDate.value, ".") - 1)) _
                & " " & CStr(MonthName(CLng(Mid(FormNewIBooking.TextBoxDate.value, InStr(FormNewIBooking.TextBoxDate.value, ".") + 1, 2)))) _
                & " " & CStr(Right(FormNewIBooking.TextBoxDate.value, 4))
            End With
            With .Cell(3, 3).Range
                .Font.Bold = True
                .InsertAfter "Stykpris"
            End With
            With .Cell(3, 4).Range
                .Font.Bold = True
                .InsertAfter "Totalpris"
            End With

[COLOR=#00ff00]'//////////     Populate fourth
[/COLOR]
            With .Cell(4, 1).Range
                If (FormNewIBooking.ListBoxAntal.ListCount <> 0) Then
                    For Each Item In FormNewIBooking.ListBoxAntal.List
                        If (Item <> "") Then
                            .InsertAfter Item & vbNewLine
                        End If
                    Next
                End If
            End With
            With .Cell(4, 2).Range
                If (FormNewIBooking.ActivityList.ListCount <> 0) Then
                    For Each Item In FormNewIBooking.ActivityList.List
                        If (Item <> "") Then
                            .InsertAfter Item & vbNewLine
                        End If
                    Next
                End If
            End With
            With .Cell(4, 3).Range
                If (FormNewIBooking.ListBoxStkPrice.ListCount <> 0) Then
                    For Each Item In FormNewIBooking.ListBoxStkPrice.List
                        If (Item <> "") Then
                            .InsertAfter Item & vbNewLine
                        End If
                    Next
                End If
            End With
            With .Cell(4, 4).Range
                If (FormNewIBooking.ListBoxTotalPrice.ListCount <> 0) Then
                    For Each Item In FormNewIBooking.ListBoxTotalPrice.List
                        If (Item <> "") Then
                            .InsertAfter Item & vbNewLine
                        End If
                    Next
                End If
            End With
            
[COLOR=#00ff00]'//////////     Populate fifth row
[/COLOR]            
            With .Cell(5, 1).Range
                .Font.Bold = True
                .InsertAfter "Total"
            End With
            With .Cell(5, 2).Range
                .Font.Bold = True
                .InsertAfter "DKK " & FormNewIBooking.TextBoxPrice.value
            End With
            
[COLOR=#00ff00]'//////////     Populate sixth row
[/COLOR]
        With .Cell(6, 1).Range
                .InsertAfter vbNewLine
                Set objWordBem = CreateObject("Word.Application")
                Set objDocBem = objWord.Documents.Open(Application.ActiveWorkbook.Path & "/Skabeloner/Bem.docx")
                
                objWordBem.Visible = False
                Set objSelectionBem = objWordBem.Selection
                objDocBem.Range.Select
                objDocBem.Range.Copy
                .Paste
                
                objDocBem.Close
                objWordBem.Quit
                
                .InsertAfter vbNewLine
                .InsertAfter "Venlig hilsen" & vbNewLine
                .InsertAfter "Museumsinspektør" & vbNewLine
                .InsertAfter FormNewIBooking.TextBoxSign.value & vbNewLine
                .InsertAfter vbNewLine & "Vikingeborgen Trelleborg"
            End With
        End With
    
[COLOR=#00ff00]'////////////////////////////////////////////////////////////////////
'//////////             Save file and Terminate            //////////
'////////////////////////////////////////////////////////////////////

'//////////     add sagsnummer to bookinglist
[/COLOR]    FormIBookings.ListBox1.AddItem (FormNewIBooking.TextBoxSNR.value)
            
[COLOR=#00ff00]'//////////     Save file
[/COLOR]    
    objDoc.SaveAs (ThisWorkbook.Path & "/" & FormNewIBooking.TextBoxDate.value & ". " & FormNewIBooking.TextBoxUF.value & ". " & FormNewIBooking.TextBoxSI.value & ". " & FormNewIBooking.TextBoxFirstName.value & ".docx")
    
[COLOR=#00ff00]'//////////     print page
[/COLOR]    
    If (FormNewIBooking.CheckBoxPrint.value = True) Then objDoc.PrintOut Copies:=1
    
[COLOR=#00ff00]'//////////     save workbooks
[/COLOR]                
    For Each w In Application.Workbooks
        w.Save
    Next w
    
[COLOR=#00ff00]'//////////     Userform
[/COLOR]            
    Unload Me
    Unload FormActOptions
    Unload FormIActivities

[COLOR=#00ff00]    'objWord.Quit [/COLOR][COLOR=#0000ff]- I do not want to kill word when the procesure is over, as the user have the be able to confirm that the content of the word file is correct, or add modifications that the code is not meant to handle... at least not yet.[/COLOR]
    Set objWord = Nothing
    Set objDoc = Nothing
    Set tableNew = Nothing
End If
End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Try using Application.InchesToPoints rather than just InchesToPoints
 
Upvote 0
Setting objselection = Nothing at the end of the document solved the issue!
It's running smoothly with Application.InchesToPoints so I'll be keeping that as well, just in case.

Thank you so much, both of you!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,954
Messages
6,122,461
Members
449,085
Latest member
ExcelError

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top