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

• #16482 Mutt senior tag Vladek83 #16479

  Új Válasz 2013-01-24 20:41:29 #16482

  Ú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

  

  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:=xlPasteAllUsingSourceTheme

  Azonban 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