VBA macro voettekst elk tabblad

Status
Niet open voor verdere reacties.

KCSB

Gebruiker
Lid geworden
9 sep 2020
Berichten
19
Beste,

Ik heb een macro gemaakt voor een draaitabel rapport filterpagina. Hieruit komen ongeveer 10 tabbladen.
Op elk tabblad wil ik een voettekst hebben met een logo.

Welke macro kan ik gebruiken?
Dat alle tabbladen een voettekst met logo krijgen.

Hopelijk ben ik duidelijk, ik geef graag meer toelichting.

Gr. KCSB:cool:
 
Macrorecorder al gebruikt ?
 
Bedankt voor je bericht, kun je hier meer uitleg over geven?

De werkwijze van macro's is mij bekend.

Wil graag de vba code voor: op alle tabbladen een voettekst ( waar een logo) op moet komen.

Groet KCSB
 
Even de vraag: Wil je op elk tab-blad dezelfde voettekst en hetzelfde logo plaatsen? Of moet elk tab-blad een andere tekst hebben? Dezelfde vraag voor het logo. Overal dezelfde of elk blad z'n eigen logo?
 
Beste Hans,

Bedankt voor je reactie.

Je vraag: Wil je op elk tab-blad dezelfde voettekst en hetzelfde logo plaatsen?

Ja klopt, Het logo staat in een map op de schijf.
Of is het handiger dat het logo in een tabblad staat en dat de macro daar het logo uit leest?!?
Ik ben opzoek naar de macro hiervoor.
 
Met een macro-opname was je een heel eind gekomen.
Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.PageSetup.CenterFooterPicture.Filename = "E:\Temp\Knipsel.JPG"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "Mijn tekst"
        .CenterFooter = "&G"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 100
        .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
    Application.PrintCommunication = True
    Range("C35").Select
End Sub

Beetje opschonen en een lusje er omheen en klaar.:)

Code:
Sub VenA()
  For Each sh In Sheets
    With sh.PageSetup
      .LeftFooter = "Mijn tekst"
      .CenterFooterPicture.Filename = "E:\Temp\Knipsel.JPG"
      .CenterFooter = "&G"
    End With
  Next sh
End Sub
 
Beste VenA

Super bedankt voor je input! Het is gelukt :)

Maar heb nog een vraag, er is 1 hoofdtabblad "Rooster" waarin geen voettekst of andere aanpassingen hoeft te komen.
Welke vba code kun je dan het beste gebruiken?

"alle tabbladen behalve 'rooster' "

Groet KCSB
 
Bedankt!

Maar waar zet ik dan?



Dim i As Integer
Worksheets(1).Activate
For i = 1 To Worksheets.Count
Worksheets(i).Activate

Boven of onder bovenstaande vba code??
 
In de veel effectievere code die in #6 staat. Maar als je zelf wat wil brouwen dan staat je dat natuurlijk geheel vrij.
 
Nogmaals bedankt voor de input, hiermee ben ik geholpen.
Maar snap nog niet helemaal de code voor behalve blad 'rooster'.

Ik wil alle macro's uit laten voeren behalve sheet "rooster".

Welke code gebruik ik dan?
Waar kan ik dit het beste plaatsen?

Heb al verschillende mogelijkheden geprobeerd met je eerder verstuurde code. Maar helaas nog niet het juiste resultaat.

Gr. KCSB
 
Welke macro's wil je allemaal laten uitvoeren dan?

Er zijn niet zo heel veel mogelijkheden waar je het uitsluiten van het blad neer kan zetten.

Maar even in het Nederlands:

Voor elk blad in alle bladen
Als de naam van het blad <> bepaalde naam dan
Doe wat
Einde als
 
Laatst bewerkt:
Ok, ik snap het.
Ik zal het zo maken dat het leesbaar is.
 
Document Rooster

Beste VenA,

Hierbij het document.

De vraag is; ik wil de macro's uit laten voeren behalve het tabblad Rooster. (1e tabblad).

Gr. KCSB
 

Bijlagen

  • Rooster overzicht.xlsm
    23,1 KB · Weergaven: 27
Ik denk dat je het verkeerde bestand geplaatst hebt.
 
Hierbij nogmaals het document.

Onderstaand de macro in het document.

Vraag; waar plaats ik nu de code: alles uitvoeren behalve blad 'Rooster'.


Code:
 Sub schooloverzichtopmaak()
'
' schooloverzicht opmaak Macro
'
    Range("C9").Select
    ActiveSheet.PivotTables("Rooster").ShowPages PageField:="Schoolnaam"
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=2
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    Sheets("Rooster").Select
    Sheets("Rooster").Move Before:=Sheets(1)
    ActiveWindow.SmallScroll Down:=-6
    Sheets("Rooster").Select
    Range("D10").Select
    
    Dim i As Integer
Worksheets(1).Activate
    For i = 1 To Worksheets.Count
    Worksheets(i).Activate
      ActiveSheet.UsedRange.EntireColumn.AutoFit
         Worksheets(i).PageSetup.Orientation = xlLandscape
   
   
   ' kleurregeltoevoegen Macro
'


'
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1:G2").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Arimo"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PDF Rooster"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Datum:"
    Range("F2").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("G2").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 18
    Range("B2").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
    Columns("B:B").Select
    Columns("B:B").EntireColumn.AutoFit
    Columns("G:G").Select
    Columns("G:G").EntireColumn.AutoFit
    Range("B4").Select
Next
End Sub
 

Bijlagen

  • Rooster overzicht.xlsm
    25,5 KB · Weergaven: 26
Je bestand bevat slechts 1 werkblad.
 
Beste snb,

Dit is correct, als de macro wordt uitgevoerd. komen er meer tabbladen.
Maar wanneer de macro wordt uitgevoerd wil ik alleen deze opdrachten hebben behalve het tabblad 'Rooster'.
 
Als je een macro opneemt dan is het de bedoeling om al het overbodige eruit te halen. Zie ook #6

Code:
Sub schooloverzichtopmaak()
  With Sheets("Rooster")
    .PivotTables("Rooster").ShowPages "Schoolnaam"
    .Move Sheets(1)
  End With
    
  For Each sh In Sheets
    With sh
      .Rows(1).Insert
      With .Range("A1:G2")
        .Interior.ThemeColor = xlThemeColorAccent1
        .Interior.TintAndShade = 0.799981688894314
        .Font.Name = "Arimo"
      End With
      .Range("C1") = "PDF Rooster"
      .Range("F2:G2") = Array("Datum:", "=Today()")
      .Range("F2").HorizontalAlignment = xlRight
      .Range("G2").HorizontalAlignment = xlLeft
      .Columns.AutoFit
      With .PageSetup
        .Orientation = xlLandscape
        If sh.Name <> "Rooster" Then
          .LeftFooter = "Mijn tekst"
          .CenterFooterPicture.Filename = "E:\Temp\Knipsel.JPG"
          .CenterFooter = "&G"
        End If
      End With
    End With
  Next sh
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan