-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
válasz
Mr.Csizmás
#10686
üzenetére
Oksa, akkor ennyi lenne, felkommenteztem, ahol kell, remélem egyértelmű.
Private Function FSCD_Header_Footer_Changer()
'hol találhatóak az Excel munkafüzetek
Const MY_PATH = "D:\mrcsizmas\"
'mi a kiterjsztésük
'(ez így azért is jó, mert az xlsx fájlok is olvashatók)
Const MY_EXTENSION = "xls"
Const MY_HEADER_LEFT = "Fejlécben BALRA kerülő szöveg"
Const MY_HEADER_CENTER = "Fejlécben KÖZÉPRE kerülő szöveg"
Const MY_HEADER_RIGHT = "Fejlécben JOBBRA kerülő szöveg"
Const MY_FOOTER_LEFT = "Láblécben BALRA kerülő szöveg"
Const MY_FOOTER_CENTER = "Láblécben KÖZÉPRE kerülő szöveg"
Const MY_FOOTER_RIGHT = "Láblécben JOBBRA kerülő szöveg"
'csak a láblécek legyenek módosítva
'False értékre állítva, a fejléceket is módosíthatod
Const MY_ONLY_FOOTER = True
Dim My_WorkBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FName = Dir(MY_PATH & "*." & MY_EXTENSION)
Do While Len(FName) > 0
Set My_WorkBook = Workbooks.Open(MY_PATH & FName)
With My_WorkBook
For i = 1 To .Worksheets.Count
.Worksheets(i).PageSetup.LeftFooter = MY_FOOTER_LEFT
.Worksheets(i).PageSetup.CenterFooter = MY_FOOTER_CENTER
.Worksheets(i).PageSetup.RightFooter = MY_FOOTER_RIGHT
If Not MY_ONLY_FOOTER Then
.Worksheets(i).PageSetup.LeftHeader = MY_HEADER_LEFT
.Worksheets(i).PageSetup.CenterHeader = MY_HEADER_CENTER
.Worksheets(i).PageSetup.RightHeader = MY_HEADER_RIGHT
End If
Next i
.Save
.Close
End With
Set My_WorkBook = Nothing
FName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Az összes munkafüzet módosítása sikeresen megtörtént.")
End FunctionUI: Először azért készíts másolatot a módisítani kívánt fájlokról, biztos , ami biztos...
![;]](//cdn.rios.hu/dl/s/v1.gif)
[ Módosította: Grafiqs ]
Új hozzászólás Aktív témák
- Szeged és környéke adok-veszek-beszélgetek
- Milyen videókártyát?
- One otthoni szolgáltatások (TV, internet, telefon)
- Kuponkunyeráló
- Horgász topik
- Red Dead Redemption 2 (PC)
- Kínai és egyéb olcsó órák topikja
- Gaming notebook topik
- CURVE - "All your cards in one." Minden bankkártyád egyben.
- Battlefield 6
- További aktív témák...
- BESZÁMÍTÁS! GIGABYTE B250M i5 7400 16GB DDR4 512GB SSD RX Vega 64 8GB DEEPCOOL Tesseract BF 650W
- BESZÁMÍTÁS! Xiaomi 15 Ultra 5G 16GB / 512GB okostelefon garanciával hibátlan működéssel
- Elden Ring PS5 játék
- Keresek Xbox Series S / Series X / Playstation 5 konzolokat
- HIBÁTLAN iPhone 13 256GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3421
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Fferi50
