2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
Keresés
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    LOGOUT

    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

  • #10687 Fire/SOUL/CD félisten Mr.Csizmás #10686
    Új Válasz #10687
    Új hozzászólás
    Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra
    Privát üzenet küldése

    Fire/SOUL/CD

    félisten

    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 Function

    UI: Először azért készíts másolatot a módisítani kívánt fájlokról, biztos , ami biztos... ;]

    [ Módosította: Grafiqs ]

Új hozzászólás Aktív témák

Hirdetés