Ik werk met een excel sheet waarin iemand anders destijds macro's heeft aangemaakt.
Doel van de macro is dat uit het tabblad Akt.matrix een naam haalt (in de cel voor de naam staat een uniek nummer) en een nieuw tabblad aanmaakt met die naam. Vervolgens moet het formulier dat in tabblad Blanco staat in het tabblad gekopieerd worden. Ik krijg nu steeds alleen de foutmelding "De bladen zijn al aangemaakt, programma wordt beëindigd". Aangezien de macro altijd werkte kan het te maken hebben met een nieuwere excel versie. Ziet iemand zo de fout en kan dat in leken taal aangeven? (Ben zelf geen macro bouwer...)
Sub Bladen_ineenkeer_aanmaken()
On Error GoTo programmaeinde
Application.ScreenUpdating = False
Sheets("Akt. matrix").Select
Application.Goto Reference:="R2C1"
Do While ActiveCell <> ""
hulppersnr = ActiveCell
ActiveCell.Offset(0, 1).Range("A1").Select
hulpnaam = ActiveCell
ActiveCell.Offset(0, -1).Range("A1").Select
'Sheets(hulpnaam).Select
'ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Worksheets.Add.Name = hulpnaam
'MsgBox (Sheets.Count)
'End
Sheets("Blanco").Select
Cells.Select
Selection.Copy
Sheets(hulpnaam).Select
Cells.Select
ActiveSheet.Paste
Application.Goto Reference:="R6C3"
ActiveCell = hulppersnr
Rows("45:45").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.62992125984252)
.BottomMargin = Application.InchesToPoints(0.47244094488189)
.HeaderMargin = Application.InchesToPoints(0.590551181102362)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Sheets("Akt. matrix").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Sheets("Akt. matrix").Select
Sheets("Akt. matrix").Move Before:=Sheets(3)
Sheets("Blanco").Select
Sheets("Blanco").Move Before:=Sheets(4)
Sheets("Knoppenblad").Select
Application.ScreenUpdating = True
programmaeinde:
'MsgBox (Err.Number)
Select Case Err.Number
Case 1004
MsgBox ("De bladen zijn al aangemaakt, programma wordt beëindigd")
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Knoppenblad").Select
Err.Clear
End
Case Else
'ActiveWindow.SelectedSheets.Delete
Err.Clear
End Select
End Sub
Doel van de macro is dat uit het tabblad Akt.matrix een naam haalt (in de cel voor de naam staat een uniek nummer) en een nieuw tabblad aanmaakt met die naam. Vervolgens moet het formulier dat in tabblad Blanco staat in het tabblad gekopieerd worden. Ik krijg nu steeds alleen de foutmelding "De bladen zijn al aangemaakt, programma wordt beëindigd". Aangezien de macro altijd werkte kan het te maken hebben met een nieuwere excel versie. Ziet iemand zo de fout en kan dat in leken taal aangeven? (Ben zelf geen macro bouwer...)
Sub Bladen_ineenkeer_aanmaken()
On Error GoTo programmaeinde
Application.ScreenUpdating = False
Sheets("Akt. matrix").Select
Application.Goto Reference:="R2C1"
Do While ActiveCell <> ""
hulppersnr = ActiveCell
ActiveCell.Offset(0, 1).Range("A1").Select
hulpnaam = ActiveCell
ActiveCell.Offset(0, -1).Range("A1").Select
'Sheets(hulpnaam).Select
'ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Worksheets.Add.Name = hulpnaam
'MsgBox (Sheets.Count)
'End
Sheets("Blanco").Select
Cells.Select
Selection.Copy
Sheets(hulpnaam).Select
Cells.Select
ActiveSheet.Paste
Application.Goto Reference:="R6C3"
ActiveCell = hulppersnr
Rows("45:45").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.62992125984252)
.BottomMargin = Application.InchesToPoints(0.47244094488189)
.HeaderMargin = Application.InchesToPoints(0.590551181102362)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Sheets("Akt. matrix").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Sheets("Akt. matrix").Select
Sheets("Akt. matrix").Move Before:=Sheets(3)
Sheets("Blanco").Select
Sheets("Blanco").Move Before:=Sheets(4)
Sheets("Knoppenblad").Select
Application.ScreenUpdating = True
programmaeinde:
'MsgBox (Err.Number)
Select Case Err.Number
Case 1004
MsgBox ("De bladen zijn al aangemaakt, programma wordt beëindigd")
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Knoppenblad").Select
Err.Clear
End
Case Else
'ActiveWindow.SelectedSheets.Delete
Err.Clear
End Select
End Sub