Macro pagina toevoegen en verwijderen

[kdapp]

Ik heb de volgende macro gemaakt om een pagina toe te voegen, het nadeel is alleen dat als ik hem nog een keer klik dan krijg ik nog een pagina en dat wil ik niet, het is de bedoeling dat ik deze macro maar een keer mag en kan aanklikken wie kan mij helpen dit te realiseren:

Sub PaginaToevoegen()
ActiveSheet.Unprotect
Rows("43:43").Select
Selection.Copy
Rows("44:80").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$C$3:$M$90"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.47244094488189)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.15748031496063)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
True
End Sub

Ook heb ik de volgende macro gemaakt om de betreffende pagina te verwijderen, hier heb ik het zelfde probleem hij mag hem maar één keer weg halen en niet meerdere keren wie kan daar mee helpen:

Sub PaginaVerwijderen()
ActiveSheet.Unprotect
Rows("44:80").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-12
Range("D20").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
True
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$C$3:$M$53"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.47244094488189)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.15748031496063)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End Sub

Alvast bedankt.

 

[paulva]

Het gemakkelijkste lijkt me om een switch te plaatsen in je eigen werkblad. De volgende code plaatst die in cel a1, maar je kan hem eigenlijk beter een beetje verstoppen.

ActiveSheet.Unprotect
If Cells(1, 1).Value = "macro uitgevoerd" Then
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
    True
    MsgBox "macro al uitgevoerd"
    Exit Sub
End If
Cells(1, 1).Value = "macro uitgevoerd"

 

[kdapp]

bedankt ga ik dit is goed genoeg ga ik proberen