erg trage code

[grietsenwijma]

Ik heb een code opgenomen waarmee via de header achter het hele document een achtergrond wordt toegevoegd (of verwijderd)

Werkt uitstekend, alleen wel traag.
Ik denk dat dat is dat omdat ie alle documentinstellingen opnieuw instelt.
Als je er van uit gaat dat die goed zijn moet je volgens mij met 1 'a 2 regeltjes code kunnen volstaan.
Ik ben wel aan het experimenteren geweest met delen er uit te krassen maar krijg de boel niet aan de praat.
…….terwijl het vast érg simpel is.

Wie heeft een suggestie?

Onderstaand de code:

Sub AchtergrondBIJ()
'
' AchtergrondBIJ Macro
'
    ActiveSheet.PageSetup.CenterHeaderPicture.Filename = _
        "G:\XXXXXXXXXX\XXXXXXXXXX\XXXXXXXXXXXXXXX\XXXXXXXXXXXXXXX.png"
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$6"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "$C$2:$M$861"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&G"
        .RightHeader = ""
        .LeftFooter = "&""Arial,Standaard""&8&D" & Chr(10) & "" & Chr(10) & ""
        .CenterFooter = ""
        .RightFooter = _
        "&""Arial,Standaard""&8blad &P van &N&K00+000----------&K000000" & Chr(10) & "" & Chr(10) & ""
        .LeftMargin = Application.InchesToPoints(0.748031496062992)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(1.06299212598425)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .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 = 98
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .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

 

[AccessGuru]

Kan inderdaad een stuk korter. Lees in je code waar wat wordt ingesteld, en je weet wat er weg kan.

Sub Macro1()
    With ActiveSheet.PageSetup
        .PageSetup.CenterFooterPicture.Filename = [COLOR=#333333]"G:\XXXXXXXXXX\XXXXXXXXXX\XXXXXXXXXXXXXXX\XXXXXXXXXXXXXXX.png"[/COLOR]
        .CenterFooter = "&G"
    End With
    Application.PrintCommunication = True
End Sub

Laatste regel kan wellicht ook nog weg.

 

[grietsenwijma]

...ik dacht dat ik 'm daarmee had.
Maar zodra ik iets verander of wegkras aan de riedel pagina instellingen die deze code naloopt pakt hij de afbeelding in de header niet meer.

Ik heb de (tegengestelde) code voor het verwijderen van de header ook op jou wijze aangepast en die doet nu het wel goed en snel. (maar daar is niks in de header juist het beoogde resultaat)

 

[grietsenwijma]

Om het probleem even opnieuw onder de aandacht te brengen want de oplossing is er nog steeds niet.
Voor het weghalen van de briefachtergrond werkt de verkorte code uitstekend

Voor het aanbrengen van de afbeelding in de header doet de code niks meer zodra ik er iets aan verander
Dat zou toch anders moeten kunnen. waar de code zijn tijd mee "verprutst" is het nalopen van alle pagina instellingen. (terwijl die al goed staan) Zodra ik ook maar iets daar aan verander werkt de code niet meer.
Dat zou toch wel moeten kunnen, uitvoeren van de code kost nu ongeveer 20 seconden. erg lang als je er op moet wachten.

 

[snb]

Het heeft geen zin je eerdere teksten exact te herhalen.

Hier loopt alles vlekkelings met:

Sub M_snb()
  With Sheet1.PageSetup
    With .LeftHeaderPicture
      .Filename = "G:\OF\appel.jpg"
      .Height = 577
      .Width = 529
    End With
    .CenterHeaderPicture.Filename = "G:\OF\peer.jpg"
    .RightHeaderPicture.Filename = "G:\OF\framboos.jpg"
    .LeftFooterPicture.Filename = "G:\OF\aardbei.jpg"
    .CenterFooterPicture.Filename = "G:\OF\sinaasappel.jpg"
    .RightFooterPicture.Filename = "G:\OF\appel.jpg"
    .LeftHeader = "&G"
    .CenterHeader = "&G"
    .RightHeader = "&G"
    .LeftFooter = "&G"
    .CenterFooter = "&G"
    .RightFooter = "&G"
  End With
End Sub

Lees aandachtig en doe er je voordeel mee.

 

[grietsenwijma]

Bedankt!

Moest de boel met try&error even naar m'n eigen situatie aanpassen maar 't is nu klaar.

Ik ben van 20 seconden verwerkingstijd teruggegaan naar 5.
Nog steeds niet flitsend maar beslist acceptabel.

Nogmaals dank, ik ga de vraag als opgelost markeren.

 

[cow18]

Dat hoef je toch maar eenmalig te doen of niet ?