Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox "folder bestaat" & IIf(fs.folderExists("/Users/homecare/Documents/Geertje/Facturen/" & Year(Date)), "", " niet")
Zie reactie van EdmoorNog een optie voor windows, of het werkt op een MAC....?
Code:Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") MsgBox "folder bestaat" & IIf(fs.folderExists("/Users/homecare/Documents/Geertje/Facturen/" & Year(Date)), "", " niet")
Het FileSystem Object is een onderdeel van de Windows Scripting Library.
Dat zal op een Mac niet aanwezig zijn.
Waarom sla je niet gewoon even op F1 in de VBEditor terwijl dir gemarkeerd is ?
De meeste hulp zit onder vingerbereik en niet op Internet.
Function FileOrFolderExistsOnYourMac(FileOrFolderstr As String, FileOrFolder As Long) As Boolean
'Ron de Bruin : 13-Dec-2020, for Excel 2016 and higher
'Function to test if a file or folder exist on your Mac
'Use 1 as second argument for File and 2 for Folder
Dim ScriptToCheckFileFolder As String
Dim FileOrFolderPath As String
If FileOrFolder = 1 Then
'File test
On Error Resume Next
FileOrFolderPath = Dir(FileOrFolderstr & "*")
On Error GoTo 0
If Not FileOrFolderPath = vbNullString Then FileOrFolderExistsOnYourMac = True
Else
'folder test
On Error Resume Next
FileOrFolderPath = Dir(FileOrFolderstr & "*", vbDirectory)
On Error GoTo 0
If Not FileOrFolderPath = vbNullString Then FileOrFolderExistsOnYourMac = True
End If
End Function
Sub M_snb()
on error resume next
mkdir "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date)
on error goto 0
thisworkbook.saveas "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date) & "/voorbeeld.xlsm",52
End Sub
Wat is eenvoudiger dan een folder aanmaken ?
Een check is dan overbodig.
Code:Sub M_snb() on error resume next mkdir "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date) on error goto 0 thisworkbook.saveas "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date) & "/voorbeeld.xlsm",52 End Sub
Heb je de code wel getest ?
De code doet precies wat ie moet doen zoals jij het beschrijft.
Die aparte knop is overbodig.
Verwijder de folder voor 2022 en laat dan de code lopen.
Ik vind het wel zorgwekkend dat je zegt dat een code niet goed zou zijn, waaruit blijkt dat jij hem niet snapt en niet test.
Dan is iedere hulp zinloos.
'Save data of verkoopfactuur on sheet inkomsten.
Sub PDF_Boeken_Nieuws()
Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Integer
Dim Mndm, MnDnr, YrNr
' Make some sheet variables .
Set sourceSheet = Worksheets("verkoopfactuur")
Set dataSheet = Worksheets("Inkomsten")
'Unprotect the Worksheet
Sheets("Inkomsten").Unprotect
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Wilt u deze factuur boeken?.", vbYesNo + vbQuestion + vbDefaultButton2, " ")
If Answer = vbYes Then
On Error Resume Next
MkDir "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date)
On Error GoTo 0
With Sheets("Verkoopfactuur")
'maak PDF
pdf = "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date) & "/" & .Range("H11").Value & " " & .Range("H5").Value & " " & .Range("H10").Value & ".pdf"
Range("F2:M59").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdf
' boeken factuur
' Get the next empty row from the Data sheet.
nextRow = dataSheet.Range("F" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row
Mndm = sourceSheet.Range("H10")
MnDnr = Month(Mndm)
YrNr = Year(Mndm)
' Input the form values into the Data sheet.
dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("H10").Value
dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("Q3").Value
dataSheet.Cells(nextRow, 8).Value = sourceSheet.Range("H11").Value
dataSheet.Cells(nextRow, 9).Value = sourceSheet.Range("I15").Value
dataSheet.Cells(nextRow, 10).Value = sourceSheet.Range("H5").Value
dataSheet.Cells(nextRow, 11).Value = sourceSheet.Range("L45").Value
dataSheet.Cells(nextRow, 12).Value = sourceSheet.Range("L46").Value
dataSheet.Cells(nextRow, 13).Value = sourceSheet.Range("L47").Value
dataSheet.Cells(nextRow, 14).Value = sourceSheet.Range("L48").Value
dataSheet.Cells(nextRow, 15).Value = sourceSheet.Range("Q4").Value
dataSheet.Cells(nextRow, 16).Value = sourceSheet.Range("Q7").Value
dataSheet.Cells(nextRow, 17).Value = sourceSheet.Range("O15").Value
dataSheet.Cells(nextRow, 19).Value = MnDnr
dataSheet.Cells(nextRow, 20).Value = YrNr
'nieuwe factuur
.Range("H5,O15,G15:K43").ClearContents
.Range("O2").Value = Range("O2").Value + 1
Application.Goto .Range("H5")
End With
UserForm2.Show
Else
MsgBox "Factuur is niet geboekt"
Application.Goto sourceSheet.Range("H5")
End If
Sheets("Inkomsten").Protect
Sheets("Gegevens").Protect
End Sub
Set shtInkomsten = Worksheets("Inkomsten")
[COLOR=#333333]Set dataSheet = Worksheets("Inkomsten")[/COLOR]
'Save data of verkoopfactuur on sheet inkomsten.Sub PDF_Boeken_Nieuws()
Dim shtVerkoopfactuur As Worksheet
Dim shtInkomsten As Worksheet
Dim nextRow As Integer
' Make some sheet variables.
Set shtVerkoopfactuur = Worksheets("verkoopfactuur")
Set shtInkomsten = Worksheets("Inkomsten")
'Unprotect the Worksheet
shtInkomsten.Unprotect
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Wilt u deze factuur boeken?.", vbYesNo + vbQuestion + vbDefaultButton2, " ")
If Answer = vbYes Then
On Error Resume Next
MkDir "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date)
On Error GoTo 0
With shtVerkoopfactuur
'maak PDF
pdf = "/Users/homecare/Documents/Geertje/Facturen/" & Year(Date) & "/" & .Range("H11").Value & " " & .Range("H5").Value & " " & .Range("H10").Value & ".pdf"
Range("F2:M59").Select ' Hier wordt niets mee gedaan?
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf 'Is activesheet toevallig hetzelfde als shtVerkoopfactuur?
' boeken factuur
' Get the next empty row from the Data sheet.
nextRow = shtInkomsten.Range("F" & shtInkomsten.Rows.Count).End(xlUp).Offset(1).Row
' Input the form values into the Data sheet.
shtInkomsten.Cells(nextRow, 6).Value = .Range("H10").Value
shtInkomsten.Cells(nextRow, 7).Value = .Range("Q3").Value
shtInkomsten.Cells(nextRow, 8).Value = .Range("H11").Value
shtInkomsten.Cells(nextRow, 9).Value = .Range("I15").Value
shtInkomsten.Cells(nextRow, 10).Value = .Range("H5").Value
shtInkomsten.Cells(nextRow, 11).Value = .Range("L45").Value
shtInkomsten.Cells(nextRow, 12).Value = .Range("L46").Value
shtInkomsten.Cells(nextRow, 13).Value = .Range("L47").Value
shtInkomsten.Cells(nextRow, 14).Value = .Range("L48").Value
shtInkomsten.Cells(nextRow, 15).Value = .Range("Q4").Value
shtInkomsten.Cells(nextRow, 16).Value = .Range("Q7").Value
shtInkomsten.Cells(nextRow, 17).Value = .Range("O15").Value
shtInkomsten.Cells(nextRow, 19).Value = Month(.Range("H10"))
shtInkomsten.Cells(nextRow, 20).Value = Year(.Range("H10"))
'nieuwe factuur
.Range("H5,O15,G15:K43").ClearContents
.Range("O2").Value = Range("O2").Value + 1
Application.Goto .Range("H5")
End With
UserForm2.Show
Else
MsgBox "Factuur is niet geboekt"
Application.Goto .Range("H5")
End If
shtInkomsten.Protect
Sheets("Gegevens").Protect
End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.