Hi,
I have some code running in Access that adapts an Excel file:
My Code =
CODE
Function WerkBladN101()
Dim n As Integer
Dim c As Range
Set XLApp = New Excel.Application
Set xlWB = XLApp.Workbooks.Open(FileName:=CurDir & "\Listing62B_101_" & m & ".xls")
'Select last row in worksheet.
Selection.End(xlDown).Select
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert Shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
n = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A65536").End(xlUp).Select
Do Until ActiveCell.Row = 2
If n <= 0 Then
Exit Do
End If
Range(Cells(n, "I"), Cells(n, "N")).Copy
n = n + 1
ActiveCell.Offset(1, 0).Select
Range(Cells(n, "B"), Cells(n, "G")).PasteSpecial Paste:=xlValues
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).Weight = xlThin
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
n = n - 3
If n <= 0 Then
Exit Do
End If
ActiveCell.Offset(-3, 0).Select
Loop
Columns("I:N").Select
Selection.Delete Shift:=xlToLeft
With xlWB.Worksheets(1)
.PageSetup.Orientation = 2 'Landscape
.PageSetup.LeftMargin = 40
.PageSetup.RightMargin = 10
.PageSetup.TopMargin = 25
.PageSetup.BottomMargin = 50
.PageSetup.CenterHeader = ""
.PageSetup.LeftFooter = "&""Arial""&08" & Voet101
.PageSetup.RightFooter = "&""Arial""&08" & "Pagina &P van &N"
.Columns("A:K").AutoFit
.Columns("A").HorizontalAlignment = xlCenter
.Columns("B").HorizontalAlignment = xlLeft
.Columns("D").HorizontalAlignment = xlLeft
.Columns("F").HorizontalAlignment = xlCenter
.Columns("G").HorizontalAlignment = xlCenter
.Columns("H").HorizontalAlignment = xlCenter
.Columns("A").ColumnWidth = 5
.Columns("B").ColumnWidth = 12
.Columns("C").ColumnWidth = 30
.Columns("D").ColumnWidth = 35
.Columns("E").ColumnWidth = 19
.Columns("F").ColumnWidth = 12
.Columns("G").ColumnWidth = 10
.Columns("H").ColumnWidth = 8.29
.Columns("F").NumberFormat = "0.00"
.Range("A1").EntireRow.Font.Bold = True
.Range("A1").EntireRow.HorizontalAlignment = xlCenter
.Range("A2").EntireRow.Font.Bold = True
.Range("A2").EntireRow.HorizontalAlignment = xlCenter
.Range("B2") = "NN"
.Range("C2") = "NAAM"
.Range("D2") = "STRAAT"
.Range("E2") = "POST+GEMEENTE"
.Range("F2") = "OVK BEST"
.Range("G2") = "SOORT"
.Range("A1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("B1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("C1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("D1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("E1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("F1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("G1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("H1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("A2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("B2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("C2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("D2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("E2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("F2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("G2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("H2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 9
End With
XLApp.DisplayAlerts = False
xlWB.SaveAs FileName:=CurDir & "\Listing62B_101_" & m & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
XLApp.DisplayAlerts = True
XLApp.Workbooks.Close
XLApp.Quit
Set xlWB = Nothing
Set XLApp = Nothing
End Function
Problem is when I run it for a second time I get the following error : Run-time Error : 91 Object variable or With block variable not set.
It does this on the line:
Selection.End(xlDown).Select
I'm looking for help.
Bert
I have some code running in Access that adapts an Excel file:
My Code =
CODE
Function WerkBladN101()
Dim n As Integer
Dim c As Range
Set XLApp = New Excel.Application
Set xlWB = XLApp.Workbooks.Open(FileName:=CurDir & "\Listing62B_101_" & m & ".xls")
'Select last row in worksheet.
Selection.End(xlDown).Select
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert Shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
n = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A65536").End(xlUp).Select
Do Until ActiveCell.Row = 2
If n <= 0 Then
Exit Do
End If
Range(Cells(n, "I"), Cells(n, "N")).Copy
n = n + 1
ActiveCell.Offset(1, 0).Select
Range(Cells(n, "B"), Cells(n, "G")).PasteSpecial Paste:=xlValues
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).Weight = xlThin
Range(Cells(n, "A"), Cells(n, "H")).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
n = n - 3
If n <= 0 Then
Exit Do
End If
ActiveCell.Offset(-3, 0).Select
Loop
Columns("I:N").Select
Selection.Delete Shift:=xlToLeft
With xlWB.Worksheets(1)
.PageSetup.Orientation = 2 'Landscape
.PageSetup.LeftMargin = 40
.PageSetup.RightMargin = 10
.PageSetup.TopMargin = 25
.PageSetup.BottomMargin = 50
.PageSetup.CenterHeader = ""
.PageSetup.LeftFooter = "&""Arial""&08" & Voet101
.PageSetup.RightFooter = "&""Arial""&08" & "Pagina &P van &N"
.Columns("A:K").AutoFit
.Columns("A").HorizontalAlignment = xlCenter
.Columns("B").HorizontalAlignment = xlLeft
.Columns("D").HorizontalAlignment = xlLeft
.Columns("F").HorizontalAlignment = xlCenter
.Columns("G").HorizontalAlignment = xlCenter
.Columns("H").HorizontalAlignment = xlCenter
.Columns("A").ColumnWidth = 5
.Columns("B").ColumnWidth = 12
.Columns("C").ColumnWidth = 30
.Columns("D").ColumnWidth = 35
.Columns("E").ColumnWidth = 19
.Columns("F").ColumnWidth = 12
.Columns("G").ColumnWidth = 10
.Columns("H").ColumnWidth = 8.29
.Columns("F").NumberFormat = "0.00"
.Range("A1").EntireRow.Font.Bold = True
.Range("A1").EntireRow.HorizontalAlignment = xlCenter
.Range("A2").EntireRow.Font.Bold = True
.Range("A2").EntireRow.HorizontalAlignment = xlCenter
.Range("B2") = "NN"
.Range("C2") = "NAAM"
.Range("D2") = "STRAAT"
.Range("E2") = "POST+GEMEENTE"
.Range("F2") = "OVK BEST"
.Range("G2") = "SOORT"
.Range("A1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("B1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("C1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("D1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("E1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("F1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("G1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("H1").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("A2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("B2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("C2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("D2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("E2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("F2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("G2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Range("H2").BorderAround xlContinuous, ColorIndex:=xlAutomatic, Weight:=xlMedium
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 9
End With
XLApp.DisplayAlerts = False
xlWB.SaveAs FileName:=CurDir & "\Listing62B_101_" & m & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
XLApp.DisplayAlerts = True
XLApp.Workbooks.Close
XLApp.Quit
Set xlWB = Nothing
Set XLApp = Nothing
End Function
Problem is when I run it for a second time I get the following error : Run-time Error : 91 Object variable or With block variable not set.
It does this on the line:
Selection.End(xlDown).Select
I'm looking for help.
Bert