-
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
-
Mutt
senior tag
válasz
Vladek83 #16479 üzenetére
Hello,
Formázásokat átviszi, ha a kódban az értékek másolása elé mégberakod, hogy:
'formátumok másolása is
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceThemeAzonban ezzel nem biztos hogy tényleg mindent másol amire neked sükséged van, ezért inkább egy sima másolat készítését javasolnám. Ebben már a fájlneve kérdés is benne van.
Sub Masolat2()
Dim FileExt As String 'aktuális fájl kiterjesztése
Dim FileName As String 'aktuális fájl neve
Dim inputFileName As String 'felhasználó által megadott név
Dim FileExtension
Const BackupLocation As String = "C:\Temp" 'ebbe a mappába mentjük
Const masolando As String = "Sheet1" 'ezen nevű munkalapot mentjük
If MsgBox("Szeretnél másolatot készíteni?", vbYesNo, "Másolat") = vbYes Then
'kiterjesztés meghatározása
FileExtension = Split(ThisWorkbook.Name, ".")
FileExt = "." & FileExtension(UBound(FileExtension))
'az aktuális fájlnévet javasoljuk alapértelmezettnek
FileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(FileExt))
'és még kiegészítjük a mai dátummal
FileName = FileName & "_" & Format(Date, "YYYYMMDD")
'bekérjük a nevet
inputFileName = InputBox("Kérlek add meg a fájlnevét:", "Mentés másként", FileName)
'mentünk ha van név
If inputFileName <> "" Then
'megnézzük hogy létezik-e a célkönyvtár, ha nem akkor létrehozzuk
If Dir(BackupLocation, vbDirectory) = "" Then
MkDir BackupLocation
End If
'mentünk ha még nincs ilyen névvel fájl
If Dir(BackupLocation & "\" & inputFileName & FileExt) = "" Then
'mentünk
ActiveWorkbook.SaveCopyAs BackupLocation & "\" & inputFileName & FileExt
Call MsgBox("Fájl elmentve " & inputFileName & " névvel.", vbOKOnly, "Mentés")
Else
Call MsgBox(inputFileName & " már létezik!", vbExclamation, "Hiba")
End If
End If
End If
End Subüdv.
-
Új hozzászólás Aktív témák
- E-roller topik
- Kínai és egyéb olcsó órák topikja
- Milyen notebookot vegyek?
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Yettel topik
- Vezetékes FEJhallgatók
- OLED TV topic
- Meggyi001: Eldugott helyek Párizsban, amiket jó eséllyel még nem láttál... 2. rész.
- Synology NAS
- Samsung Galaxy Watch7 - kötelező kör
- További aktív témák...
- Samsung Galaxy S21 Ultra 5G / 12/256GB / Kártyafüggetlen / 12Hó Garancia
- Bomba ár! Lenovo ThinkPad T460s - i5-6GEN I 8GB I 128GB SSD I 14" FHD I Cam I W10 I Garancia!
- Készpénzes / Utalásos Videokártya és Hardver felvásárlás! Személyesen vagy Postával!
- HIBÁTLAN iPhone 12 Mini 128GB Black-1 ÉV GARANCIA - Kártyafüggetlen,MS3634,94% Akkumulátor
- HP EliteOne 800 G5 All-in-One i5-9500 32GB 1000GB 23.8" Érintőkijelző!! 1 év garancia
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest