Attribute VB_Name = "Module2"
Sub Arhiva() 'ovaj macro sluzi za arhiviranje fakture kao XLS, XLSX, XLSM format

Dim txtIme As String 'deklarisanje promenljive
Dim wbkSnimi As Workbook 'deklarisanje novog fajla
Dim rn As Integer 'promenljiva rn (pamti broj racuna, zbog links na novom fajlu)

 rn = Sheets("Tjänstfaktura").Range("H5").Value 'polje na fakturi "H5" - tj.vrednost polja
  txtIme = "C:\PDF\" & "faktura" & Range("h5") & ".xls" ' broj racuna
   Set wbkSnimi = Application.Workbooks.Add ' Otvara novu radnu svesku

ThisWorkbook.Sheets("Tjänstfaktura").Copy Before:=wbkSnimi.Sheets(1) 'Kopira list u novu radnu svesku prije Sheeta1
Application.DisplayAlerts = False ' Sprecava da se trazi potvrda za brisanje lista
wbkSnimi.Worksheets(Array("List1", "list2", "List3")).Delete 'Brise visak listova
Application.DisplayAlerts = True 'prikazuje poruku upozorenja

wbkSnimi.Sheets(1).Shapes("CommandButton1").Delete  'Brise dugme na novosnimljenom fajlu
wbkSnimi.Sheets(1).Shapes("CommandButton2").Delete 'Brise dugme na novosnimljenom fajlu


Rem ActiveWorkbook.BreakLink Name:="C:\PDF\faktura-109.xls", Type:=xlExcelLinks 'ukida link

wbkSnimi.Sheets(1).Range("h5").Value = rn 'breaklinks
wbkSnimi.SaveAs txtIme, FileFormat:=56       ' Snima novu radnu svesku kao *xlsx
' wbkSnimi.SaveAs txtIme , FileFormat:= 52     ' Snima novu radnu svesku kao *xlsm
' wbkSnimi.SaveAs txtIme   ' FileFormat:=51      ' Snima novu radnu svesku  za *.xls
wbkSnimi.Close                                 ' Zatvara novu radnu svesku

End Sub