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... )
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... )
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