Több munkalap neve egy tömbbe - VBA

Több munkalap neve egy tömbbe - VBA
2020-08-07T14:37:26+02:00
2020-08-10T15:42:31+02:00
2022-10-15T21:25:21+02:00
kovi76
Az alábbi makró helyett szeretnék egy elegánsabbat, mert igaz, hogy működik, de pl. 30-nál több munkalapnál már macerás egyesével hivatkozni rájuk.
A lényeg, hogy több munkalapot (18-70. pozíció közöttieket) szeretnék egy PDF fájlba kimásolni. Hogyan írható meg ez "szépen", hogy ne kelljen egyesével, illetve a sorszámukkal hivatkoznom rájuk? 
Ha ciklusba teszem, akkor ugye mindig csak az utolsó ill. aktuális kerül a tömbbe illetve az kerül kiválasztásra. Ha pedig beolvasom tömbbe az összes munkalap nevét, akkor azok nem lesznek aktívak és nem tudom őket pdf-be küldeni.

Köszönöm!

'Végigmegyünk a munkalapokon és tömbbe tesszük a nevüket
SheetArray = Array(Worksheets(18).Name, Worksheets(19).Name, Worksheets(20).Name, Worksheets(21).Name, Worksheets(22).Name, Worksheets(23).Name, Worksheets(24).Name, _
    Worksheets(25).Name, Worksheets(26).Name, Worksheets(27).Name, Worksheets(28).Name, Worksheets(29).Name, Worksheets(30).Name)
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
Mutasd a teljes hozzászólást!
Szia!

(igaz, hogy az első előtt vessző van - ez így jó?)

Ez bizony nem jó! Azt jelenti, hogy van egy üres tömbelemed az elején.
Biztos, hogy a makrót jól másoltad be? 
Ez a rész nagyon fontos, az Option Base 1 utasítással együtt.

Dim sarray(), sh As Worksheet, xx As Integer 'Az összes munkalap nevének begyűjtése For Each sh In Sheets: On Error Resume Next If IsError(UBound(sarray)) Then ReDim Preserve sarray(1) Else ReDim Preserve sarray(UBound(sarray) + 1) End If sarray(UBound(sarray)) = sh.Name Next
Üdv.
Mutasd a teljes hozzászólást!

  • Szia!
    Nem tudom, hogy kipróbáltad-e a makrót már.
    De ez pontosan azt csinálja, hogy a tömbben levő munkalapokat másolja ki egy db PDF fájlba.
    Mivel a Sheets(SheetArray).Select az összes tömbben levő munkalapot aktíválja, nem csak a legutolsó hozzáadottat.
    (Figyelj a változónévre, egyforma legyen mindenütt. Használd az Option Explicit utasítást a modul elején, így ellenőrizve lesz a változónév.)
    Üdv.
    Mutasd a teljes hozzászólást!
  • Igen jól csinálja amit, kell, de így egyesével kell beírnom az összes munkalap hivatkozását. Ez ennyinél még oké, de még bőven volna hozzáadandó munkalap. Én azt szeretném, hogy a tömbbe ne kelljen annyiszor beírni a munkalapra hivatkozást.

    Ezzel a ciklussal is próbálkoztam. Itt tömbbe teszem a munkalapok neveit, csak ennél ugye mindig az utolsó (x aktuális értéke) lesz kijelölve.

    For Each x In ActiveWorkbook.Worksheets
            ReDim Preserve tomb(UBound(tomb) + 1)
            tomb(UBound(tomb)) = x.Name
    Next
    Mutasd a teljes hozzászólást!
  • Szia!
    Használj For Each ciklust a nevek beírásához vagy normál For ciklust, attól függően mit szeretnél nyomtatni.

    Option Base 1 Sub Makró1() ' ' Makró1 Makró Dim sarray(), sh As Worksheet, xx As Integer 'Az összes munkalap nevének begyűjtése For Each sh In Sheets: On Error Resume Next If IsError(UBound(sarray)) Then ReDim Preserve sarray(1) Else ReDim Preserve sarray(UBound(sarray) + 1) End If sarray(UBound(sarray)) = sh.Name Next On Error GoTo 0 Sheets(sarray).Select 'Ezt a részt használhatod, ha csak meghatározott munkalapokat szeretnél nyomtatni '************************************************************** For xx = 18 To 30 On Error Resume Next If IsError(UBound(sarray)) Then ReDim Preserve sarray(1) Else ReDim Preserve sarray(UBound(sarray) + 1) End If sarray(UBound(sarray)) = Sheets(xx).Name Next On Error GoTo 0 Sheets(sarray).Select '*************************************************************** ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fneve ' helyette a nevet írod. End Sub


    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia!

    csak ennél ugye mindig az utolsó (x aktuális értéke) lesz kijelölve.

    Ezért kell a végén egy
    Sheets(tomb).Select 
    utasítást kiadni, mielőtt a nyomtatást kezdenéd.

    Üdv.
    Mutasd a teljes hozzászólást!
  • Sheets(tomb).Select

    Ezt próbáltam, de nem működik. Hibát jelez, ugyanúgy, ahogy a te makródnál is:


    On Error GoTo 0
    Sheets(sarray).Select - ez nem tetszik neki

    "Sheets osztály Select metódusa" hibás üzenetet dob.

    Egyenlőre csak hirtelen próbáltam, még behatóbban átnézem, de azért köszi!
    Mutasd a teljes hozzászólást!
  • Szia!

    Az Option Base 1 utasítást betetted a modul elejére? Így fog 1-től kezdődni a tömb index.
    Ez azért kell, mert egyébként 0-tól kezdődik a tömb index, ami esetünkben nem jó.

    Üdv.
    Mutasd a teljes hozzászólást!
  • Igen, persze. Tudom, hogy ez kell.
    Mutasd a teljes hozzászólást!
  • Szia!
    Megnézheted a tömbök tartalmát a következő utasítással az Immediate ablakban:
    ? join(tomb,",")   és enter
    Akkor láthatod, hogy milyen értékek kerültek bele. Lehet, hogy a munkalap neveid olyan karaktereket is tartalmaznak, amit nem szeret a makró.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Köszi a segítséget, de továbbra is fennáll a hiba a Sheets(array).select sornál.
    Nem igazán értem miért. A munkalapok neveit is átírtam számokra, így már az sem lehet gond. 
    Ha a join utasítással megnézem a tömböt, akkor megvannak a munkalapok nevei (igaz, hogy az első előtt vessző van - ez így jó?), de valahogy mégsem dolgozik velük. Out of range hibát dob. Azért köszi, hogy foglalkozol vele! (Egyenlőre megcsináltam a fapados módszerrel - ki van írva az összes munkalap száma -, hogy tudjam használni. Így megy.)
    Mutasd a teljes hozzászólást!
  • Szia!

    (igaz, hogy az első előtt vessző van - ez így jó?)

    Ez bizony nem jó! Azt jelenti, hogy van egy üres tömbelemed az elején.
    Biztos, hogy a makrót jól másoltad be? 
    Ez a rész nagyon fontos, az Option Base 1 utasítással együtt.

    Dim sarray(), sh As Worksheet, xx As Integer 'Az összes munkalap nevének begyűjtése For Each sh In Sheets: On Error Resume Next If IsError(UBound(sarray)) Then ReDim Preserve sarray(1) Else ReDim Preserve sarray(UBound(sarray) + 1) End If sarray(UBound(sarray)) = sh.Name Next
    Üdv.
    Mutasd a teljes hozzászólást!
  • Ez lett a jó:

    Dim tomb(), sh As Worksheet, xx As Integer
    For xx = 18 To 70
        On Error Resume Next
        If IsError(UBound(tomb)) Then
            ReDim Preserve tomb(1)
        Else
            ReDim Preserve tomb(UBound(tomb) + 1)
        End If
        tomb(UBound(tomb)) = Sheets(xx).Name
    Next
    On Error GoTo 0
        Sheets(tomb).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation

    Így utólag már nem is értem, hogy miért nem ment eddig, hiszen ez ugyanaz a kód amit megírtál , de akkor a sheets(tomb).select-re reklamált. Mintha az Option base 1 utasítást figyelmen kívül hagyta volna és ezidáig ezért nem ment! Szóval egy nagy pirospont és +50! Köszi!
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd