• 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.

foutmelding macro

Status
Niet open voor verdere reacties.
A

anjapel

Gebruiker
Lid geworden
1 feb 2018
Berichten
9
goedenavond,

Mijn naam is Anja en ik ben nieuw op dit forum. Voor mijn nieuwe zaak wil ik graag boekhouden met excel. Hiervoor heb ik een opzet gedownload wat ik eel fijn vind werken. Er zit alleen een foutmelding in de macro voor het opslaan van de factuur. Ik plak hieronder de macro. In plaats van dat hij opslaat zegt hij er gaat iets mis.
Kan iemand mij vertellen wat ik moet veranderen zodat hij de facturen wel in een folder opslaat.
Sub KnopOpslaan()
On Error GoTo ErrHandler:
Dim FolderPath As String

FolderPath = Application.ActiveWorkbook.path
If Right(FolderPath, 1) <> "" Then
FolderPath = FolderPath & ""
End If

Dim jaar As Integer
jaar = Sheets("BasisInstellingen").Range("C5").Value
FolderPath = FolderPath & "Facturen" & jaar

If Dir(FolderPath, vbDirectory) = vbNullString Then
MkDir FolderPath
End If


i = 1
If isEmpty(Range("C13")) Then
pdfname = "Factuur"
Else
pdfname = "Factuur " & Range("C13")
End If

If Dir(FolderPath & "" & pdfname & ".pdf") <> "" Then
Do While Dir(FolderPath & "" & pdfname & ".pdf") <> ""

If isEmpty(Range("C13")) Then
pdfname = "Factuur " & " (" & i & ")"
Else
pdfname = "Factuur " & Range("C13") & " (" & i & ")"
End If

i = i + 1
If i = 100 Then
Exit Do
End If
Loop
End If
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.3)
.BottomMargin = Application.InchesToPoints(0.1)
.HeaderMargin = Application.InchesToPoints(0.1)
.FooterMargin = Application.InchesToPoints(0.1)
.CenterHorizontally = True
.CenterVertically = False
End With

ActiveSheet.Range("B1:F47").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "" & pdfname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Exit Sub

ErrHandler:
MsgBox "Er is iets mis gegaan"
Resume Next

End Sub

Alvast erg bedankt.

Vriendelijke groet,

Anja
 
Op welke regel loopt de macro vast, zonder het bestand te zien is het maar gokken
 
Wijzig dit:
Code: 
MsgBox "Er is iets mis gegaan"

Eens in dit om de fout zelf ook te kunnen zien:
Code: 
MsgBox Err.Description


Gebruik tevens codetags als je code plaatst.
Nu vallen er cruciale \ tekens weg en is ook de code lastig te lezen.
 
Laatst bewerkt:
Ik zou zeggen dat je beter deze regel "On Error GoTo ErrHandler:" even als comment kan zetten zodat je code écht ergens vastloopt... Of gewoon een keer regel voor regel doorlopen en debuggen. Dat is ook wel slim. ;)
 
Hartelijk dank voor jullie reactie. Ik ben bang dat dit toch iets te ingewikkeld wordt....
ik heb de eerste wijziging doorgevoerd en krijg dan
compileerfout
syntaxisfout
 
Code: 
[CODE]Sub KnopOpslaan()
    On Error GoTo ErrHandler:
        Dim FolderPath As String
    
        FolderPath = Application.ActiveWorkbook.path
        If Right(FolderPath, 1) <> "\" Then
            FolderPath = FolderPath & "\"
        End If
        
        Dim jaar As Integer
        jaar = Sheets("BasisInstellingen").Range("C5").Value
        FolderPath = FolderPath & "Facturen" & jaar
        
        If Dir(FolderPath, vbDirectory) = vbNullString Then
            MkDir FolderPath
        End If
        
        
        i = 1
        If isEmpty(Range("C13")) Then
            pdfname = "Factuur"
        Else
            pdfname = "Factuur " & Range("C13")
        End If
        
        If Dir(FolderPath & "\" & pdfname & ".pdf") <> "" Then
            Do While Dir(FolderPath & "\" & pdfname & ".pdf") <> ""
                
                If isEmpty(Range("C13")) Then
                    pdfname = "Factuur " & " (" & i & ")"
                Else
                    pdfname = "Factuur " & Range("C13") & " (" & i & ")"
                End If
                
                i = i + 1
                If i = 100 Then
                    Exit Do
                End If
            Loop
        End If
       With ActiveSheet.PageSetup
            .LeftMargin = Application.InchesToPoints(0.1)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(0.3)
            .BottomMargin = Application.InchesToPoints(0.1)
            .HeaderMargin = Application.InchesToPoints(0.1)
            .FooterMargin = Application.InchesToPoints(0.1)
            .CenterHorizontally = True
            .CenterVertically = False
        End With
        
        ActiveSheet.Range("B1:F47").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "\" & pdfname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True
        Exit Sub
        
ErrHandler:
    MsgBox MsgBox Err.Description
    Resume Next

End Sub
/CODE]

Zo goed?
 
In deze regel staat 2x MsgBox en dat is 1x teveel:
Code: 
MsgBox MsgBox Err.Description
 
Laatst bewerkt:
In de code kom ik tegen
Code: 
If Right(FolderPath, 1) <> "" Then
FolderPath = FolderPath & ""
End If

Ik denk dat het zo beter gaat
Code: 
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If

Dat geldt ook voor
Code: 
If Dir(FolderPath & "" & pdfname & ".pdf") <> "" Then
Do While Dir(FolderPath & "" & pdfname & ".pdf") <> ""

gewijzigd in
Code: 
If Dir(FolderPath & "\" & pdfname & ".pdf") <> "" Then
Do While Dir(FolderPath & "\" & pdfname & ".pdf") <> ""

Ik hoop dat het helpt.

Wouter
 
Ik heb nu onderstaande code maar de foutmelding blijft helaas. De melding is ook net met 1 keer klikken weg te drukken. Ik moet zeker een keer of 30 enteren voordat de melding verdwijnt.
Code: 
Sub KnopOpslaan()
    On Error GoTo ErrHandler:
        Dim FolderPath As String
    
        FolderPath = Application.ActiveWorkbook.path
        If Right(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
        End If
        
        Dim jaar As Integer
        jaar = Sheets("BasisInstellingen").Range("C5").Value
        FolderPath = FolderPath & "Facturen" & jaar
        
        If Dir(FolderPath, vbDirectory) = vbNullString Then
            MkDir FolderPath
        End If
        
        
        i = 1
        If isEmpty(Range("C13")) Then
            pdfname = "Factuur"
        Else
            pdfname = "Factuur " & Range("C13")
        End If
        
       If Dir(FolderPath & "\" & pdfname & ".pdf") <> "" Then
        Do While Dir(FolderPath & "\" & pdfname & ".pdf") <> ""
                
                If isEmpty(Range("C13")) Then
                    pdfname = "Factuur " & " (" & i & ")"
                Else
                    pdfname = "Factuur " & Range("C13") & " (" & i & ")"
                End If
                
                i = i + 1
                If i = 100 Then
                    Exit Do
                End If
            Loop
        End If
       With ActiveSheet.PageSetup
            .LeftMargin = Application.InchesToPoints(0.1)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(0.3)
            .BottomMargin = Application.InchesToPoints(0.1)
            .HeaderMargin = Application.InchesToPoints(0.1)
            .FooterMargin = Application.InchesToPoints(0.1)
            .CenterHorizontally = True
            .CenterVertically = False
        End With
        
        ActiveSheet.Range("B1:F47").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "\" & pdfname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True
        Exit Sub
        
ErrHandler:
    MsgBox "Er is iets mis gegaan"
    Resume Next

End Sub
 
Om te kunnen zien waar het precies fout gaat adviseer ik om de foutafvang tijdelijk te wijzigen in

Code: 
On Error GoTo 0
 
Ik krijg nu bij fout opsporen een markering bij de volgende zin:

Code: 
  If Dir(FolderPath & "\" & pdfname & ".pdf") <> "" Then /CODE]
 
Dat is na advies van WoutMag in #10?
 
Laatst bewerkt:
Ja klopt. Ik krijg wanneer ik op opslaan druk de melding: fout 68 tijdens runtime. Het apparaat is niet beschikbaar.
Ik kan dan op fout opsporen drukken en dan is deze zin geel gemarkeerd.
 
Je code in #9 doet het hier prima.
Op welke schijf probeer je de PDF op te slaan en is deze beschikbaar?
En wat staat er in C13?

Plaats anders je document.
 
Laatst bewerkt:
Ik kom vast over als een enorme digibeet :confused:
Ik heb zelf geen locatie kunnen kiezen waar ik de factuur opsla. Het is een excel sheet die ik van internet heb gedownload:
Ik voeg het bestand toe aan dit bericht.
 

Bijlagen

  • Excel-boekhouden.nl-2018.xlsm
    205,2 KB · Weergaven: 45
Je bijlage doet het prima hier met die code.
Waar heb je dat document staan als je deze opent?
 
Het staat nu bij downloads, ik heb het eerder ook geprobeerd op te slaan op mijn bureaublad maar dat gaf dezelfde foutmelding.

Ik heb overigens een macbook en daarop is een gebruiker aangemaakt waaronder ik werk.
 
Dat had je wel eerder mogen vertellen want die heeft een heel andere pad notatie.
Vandaar die foutmelding en gaat dus zo niet werken.

Bij Mac kan ik niet verder helpen.
 
Geeft niks, kon je ook niet weten :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan