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

• #16468 Mutt senior tag Vladek83 #16452

  Új Válasz 2013-01-24 10:42:43 #16468

  Ú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 #16452 üzenetére

  Hello,

  ...csak egy adott lapot szeretnék menteni, egy megadott helyre ( képleteket nem, csak értékeket ..

  Csináltam egy általánosat, amelyet könnyen tudsz magadnak beállítani.

  Sub Masolat()
  Dim FileExt As String 'aktuális fájl kiterjesztése
  Dim FileName As String 'aktuális fájl neve
  Dim FileExtension
  Const BackupLocation As String = "C:\Archive" '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
  'összes cella másolása
  Sheets(masolando).Cells.Copy
  
  'új munkafüzet létrehozása
  Workbooks.Add
  
  'értékek másolása
  Selection.PasteSpecial Paste:=xlPasteValues
  
  'felkészülés a mentésre
  '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
  
  'filekiterjesztés meghatározása
  FileExtension = Split(ThisWorkbook.Name, ".")
  FileExt = FileExtension(UBound(FileExtension))
  
  'az aktuális fájlnévet használjuk mentendőhöz
  FileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(FileExt) - 1)
  'és még kiegészítjük a mai dátummal
  FileName = FileName & "_" & Format(Date, "YYYYMMDD")
  
  'mentés XLSX formátumban (a többi típus a súgóban vagy http://msdn.microsoft.com/en-us/library/office/ff198017.aspx)
  ActiveWorkbook.SaveAs FileName:=BackupLocation & "\" & FileName, FileFormat:=xlOpenXMLWorkbook
  
  'bezárjuk az új ablakot
  ActiveWindow.Close
  
  Call MsgBox("Fájl elmentve " & FileName & " névvel.", vbOKOnly, "Mentés")
  End If
  
  End Sub

  üdv.

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