Hirdetés
- Samsung Galaxy S21 FE 5G - utóirat
- Samsung Galaxy S25 - végre van kicsi!
- Kezünkben a OnePlus 15 és az Oppo Find X9-ek
- Nothing Phone 2a - semmi nem drága
- Milyen okostelefont vegyek?
- Milyen robotporszívót vegyek karácsonyra? (2025)
- Megbüntették, ezért feloszlatná az EU-t Elon Musk
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Samsung Galaxy Watch7 - kötelező kör
- Google Pixel topik
-
Mobilarena
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
-
Nowitzki
csendes tag
válasz
Declare
#31162
üzenetére
Ez hozzáírja a fájlnévhez a mentés dátumát (év, hó, nap, óra, perc).
Sub ActiveSheetExportToPdf1()
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste_" & Format(Now, "yyyymmdd_hhnn") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End SubEz pedig hozzáad egy növekményes azonosítót a fájlnévhez ha az már létezik.
Sub ActiveSheetExportToPdf2()
cntr = ""
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") = "" Then GoTo xprt
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") <> "" Then
cntr = 1
Do Until Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") = ""
cntr = cntr + 1
Loop
End If
xprt:
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Új hozzászólás Aktív témák
- Eladó Steam kulcsok kedvező áron!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Keresem a Barkács Balázs Játékokat
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- BLACK FRIDAY! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- DX Racer fekete gamer, irodai szék
- Apple iPhone 13 Mini 128GB,Újszerű,Dobozával,12 hónap garanciával
- Apple iPhone 15 Pro 128GB, Kártyafüggetlen, 1 Év Garanciával
- BESZÁMÍTÁS! MSI B450M R5 5600X 32GB DDR4 512GB SSD RTX 3080 10GB ZALMAN Z1 Plus Cooler Master 750W
- Astro A50 4th Gen wireless + base station fejhallgató
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50

