Beste forumlezers,
Ik heb een vba code waar ik mijn excel sheet mee opsla als pdf. Deze macro regelt ook de directory op de desktop zodat het altijd op de desktop wordt opgeslagen in een map "Factuur-2019". Dit gaat prima en wil ik ook zo houden. Nu wil ik dit excel workbook als geheel ook nog opgeslagen hebben als "xlsm" file (vanwege de macro's) op dezelfde plek als waar de pdf's worden opgeslagen (desktop\Factuur-2019).
Ik heb al diverse pogingen gedaan maar mijn vba kennis is nihil, ik doe veel knip & plak van uit internet, dus ik hoop dat iemand mij hiermee kan helpen.
Onderstaande code werkt voor het pdf maken maar nog niet voor xlsm. Ik weet dat het probleem zit in het blauwe gedeelte maar krijg het niet opgelost. De drie sheets die bewaard moeten worden heten "Factuur", "Relaties" en "Invoer".
Mvgr,
FvdF
Ik heb een vba code waar ik mijn excel sheet mee opsla als pdf. Deze macro regelt ook de directory op de desktop zodat het altijd op de desktop wordt opgeslagen in een map "Factuur-2019". Dit gaat prima en wil ik ook zo houden. Nu wil ik dit excel workbook als geheel ook nog opgeslagen hebben als "xlsm" file (vanwege de macro's) op dezelfde plek als waar de pdf's worden opgeslagen (desktop\Factuur-2019).
Ik heb al diverse pogingen gedaan maar mijn vba kennis is nihil, ik doe veel knip & plak van uit internet, dus ik hoop dat iemand mij hiermee kan helpen.
Onderstaande code werkt voor het pdf maken maar nog niet voor xlsm. Ik weet dat het probleem zit in het blauwe gedeelte maar krijg het niet opgelost. De drie sheets die bewaard moeten worden heten "Factuur", "Relaties" en "Invoer".
Mvgr,
FvdF
Code:
[I]Sub SaveAsXLSM()
Dim FolderPath As String
Dim Fname As String
Dim ws As Worksheet
Fname = Range("C13") & "_" & Range("B3")
FolderPath = Application.ActiveWorkbook.Path
If Right(FolderPath, 1) <> "/" Then
FolderPath = FolderPath & "/"
End If
Dim jaar As Integer
jaar = Sheets("Invoer").Range("C5").Value
FolderPath = FolderPath & "Facturen-" & jaar
If Dir(FolderPath, vbDirectory) = vbNullString Then
MkDir FolderPath
End If
i = 1
If isEmpty(Range("C13")) Then
xlsmname = "Factuur"
Else
xlsmname = Range("C13") & "_" & Range("B3")
End If
If Dir(FolderPath & "/" & xlsmname & ".xlsm") <> "" Then
Do While Dir(FolderPath & "/" & xlsmname & ".xlsm") <> ""
If isEmpty(Range("C13")) Then
xlsmname = "Factuur " & " (" & i & ")"
Else
xlsmname = Range("C13") & "_" & Range("B3") & " (" & i & ")"
End If
i = i + 1
If i = 100 Then
Exit Do
End If
Loop
End If
Sheets(Array("Factuur", "Relaties", "Invoer")).Copy
For Each ws In ActiveWorkbook.Worksheets
With ws.UsedRange
End With
Next ws
With ActiveWorkbook
[COLOR="#0000FF"] ActiveSheet.Range("B2:G54").ExportAsFixedFormat Type:=xlTypexlsm, FileName:=FolderPath & "/" & xlsmname & ".xlsm", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True[/COLOR]
End With
Exit Sub
End Sub[/I]
Laatst bewerkt:
