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

Bij opslaan dubbel bestand melden

Status
Niet open voor verdere reacties.
R

RMSpan

Gebruiker
Lid geworden
17 mrt 2022
Berichten
82
Beste mensen

Middels Vba sla ik een sheet in de map "facturen" op als pdf bestand, werkt prima, echter als het bestand met dezelfde naam al bestaat in die map dan wordt deze zonder waarschuwing overschreven.
De vraag is waarschijnlijk al duidelijk, ik wil een melding krijgen als er al een bestand met dezelfde naam in de map "facturen" zit en dan de vraagstelling of dit bestand overschreven moet worden ja/nee.
Bij ja wordt hij overschreven en bij nee gebeurd er niets.

Dit is de code die ik heb voor het opslaan:
Code: 
Sub Opsl_2()


'Bestand save as PDF


Range("F2:M59").Select
 
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "/Users/homecare/Documents/Geertje/Facturen/" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf", _
        OpenAfterPublish:=False
    Application.ScreenUpdating = True
Range("H5").Select


End Sub

Ik heb ook het betreffende bestand bijgevoegd

Ben heel benieuwd of er een oplossing is.
 

Bijlagen

  • test form 3 V6 nieuw 27-06-2022.xlsm
    323,8 KB · Weergaven: 14
Probeer het eens zo:
Code: 
Sub Opsl_2()
    pdf = "C:\Users\homecare\Documents\Geertje\Facturen\" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf"
    If Dir(pdf) <> "" Then
        MsgBox "Een PDF met dezelfde naam is al aanwezig", vbCritical, "PDF bestaat al"
        Exit Sub
    End If
    Range("F2:M59").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdf

    Application.ScreenUpdating = True
    Range("F5").Select
End Sub
 
En bovenstaande even combineren met

Code: 
If MsgBox("Wilt u het toch opslaan?", vbYesNo, "Bestand bestaat al") = vbYes Then
        'opslaan
End If

P.S.
Misschien ook even "Foutopsporing", "VBAProject compileren" uitvoeren.
 
dubbel bestand vinden

Heren weer geweldig bedankt.
Het was niet zo moeilijk als ik had gedacht, zocht het te ver, denk ik.
Jullie hulp wordt weer enorm gewaardeerd, hierbij nog even de code die ik, met jullie input, er van heb gemaakt.(ik werk op een Mac, dus het pad moest ook even aangepast worden).

Code: 
Sub Opsl_PDF()

'Bestand save as PDF

  pdf = "/Users/homecare/Documents/Geertje/Facturen/" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf"
    If Dir(pdf) <> "" Then
        
       Dim Answer As VbMsgBoxResult
        Answer = MsgBox(" PDF bestand met deze naam bestaat al" & " " & "Wilt u doorgaan?.", vbYesNo + vbQuestion + vbDefaultButton2, " ")
            If Answer = vbYes Then
        
            Range("F2:M59").Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdf

    Application.ScreenUpdating = True
    Range("F5").Select
    
            Else

   ' Do not input the data
        MsgBox ("Bestand niet opgeslagen")
        
            Exit Sub
        End If
    End If
End Sub

Het Programme werkt nu volledig naar mijn zin, mijn nichtje zal er erg blij mee zijn.
Nogmaals mijn dank:thumb:
René
 
Het lijkt me verstandig om de knoppen "opslaan", "boeken" en "nieuwe factuur" onder 1 knop te zetten.
knop opslaan/boeken/nieuw
Probeer dit eens.
Code: 
Sub PDF_Boeken_Nieuw()
Sheets("Inkomsten").Unprotect
Sheets("Verkoopfactuur").Unprotect

With Sheets("Verkoopfactuur")
    'maak PDF
    .Range("F2:M59").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "/Users/" & Environ("username") & "/Documents/Geertje/Facturen/" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf", _
        OpenAfterPublish:=False
        
    'boeken factuur
    Sheets("Inkomsten").ListObjects(1).ListRows.Add _
    .Range.Resize(, 15) = Array(.Range("H10"), .Range("Q3"), Range("H11"), .Range("I15"), .Range("H5"), .Range("L45"), .Range("L46"), _
    .Range("L47"), .Range("L48"), "Openstaand", "8006 Omzet NL", .Range("O15"), , Month(.Range("H10")), Year(.Range("H10")))


    'afdrukken factuur
    If MsgBox("Wil je de factuur afdrukken ?", vbYesNo, "AFDRUKKEN FACTUUR") = vbYes Then
       .Range("F2:M59").PrintPreview
    End If

   'nieuwe factuur
    .Range("H5,O15,G15:K43").ClearContents
    .Range("O2").Value = Range("O2").Value + 1
     Application.Goto .Range("H5")
End With
        
        
UserForm2.Show
    
        
Sheets("Inkomsten").Protect
Sheets("Verkoopfactuur").Protect
        
        
End Sub
 
Laatst bewerkt:
Alles onder een knop

Hallo Albert

Bedankt voor het meedenken en je voorgestelde verbetering.
Ik ben het meteen gaan proberen.
Het eerste probleem met jouw voorstel is de printopdracht, die werkt niet in de Excelversie op de Mac, dit is al heel lang zo en er is nog steeds geen oplossing, voor zover mij bekend is.

Ik heb je code dan ook op een paar punten moeten aanpassen, zie hieronder de aangepaste code:

Code: 
Sub PDF_Boeken_Nieuw()
Sheets("Inkomsten").Unprotect
Sheets("Verkoopfactuur").Unprotect


With Sheets("Verkoopfactuur")
    'maak PDF
   pdf = "/Users/homecare/Documents/Geertje/Facturen/" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf"
 
        Range("F2:M59").Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdf
        
    'boeken factuur
    Sheets("Inkomsten").ListObjects(1).ListRows.Add _
    .Range.Resize(, 15) = Array(.Range("H10"), .Range("Q3"), Range("H11"), .Range("I15"), .Range("H5"), .Range("L45"), .Range("L46"), _
    .Range("L47"), .Range("L48"), "Openstaand", "8006 Omzet NL", .Range("O15"), , Month(.Range("H10")), 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
        
Sheets("Inkomsten").Protect
Sheets("Verkoopfactuur").Protect
        
End Sub

Je eerste coderegel geeft bij mij een foutmelding (Mac???)
Code: 
'maak PDF    .Range("F2:M59").ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "/Users/" & Environ("username") & "/Documents/Geertje/Facturen/" & Range("H11").Value & " " & Range("H5").Value & " " & Range("H10").Value & ".pdf", _
        OpenAfterPublish:=False

Hij wil dan de printer gaan aansturen wat onmiddellijk een foutmelding geeft, vandaar dat ik die heb aangepast en de printer opdracht heb ik ook verwijderd.
Maar nu werkt het prima, leuk.

Nogmaals bedankt
René
 
Ik heb nog een aanpassing gemaakt met opvang van foutmelding.
Als je op "opslaan/bewaar/nieuw" klikt en er is niets in de factuur ingevuld krijg je een foutmelding.
De volgende module heb ik er voor gehangen, probleem opgelost.
Code: 
Sub Validate_Form5()' Input Boeken factuur


 'Unprotect the Worksheet
        Worksheets("Verkoopfactuur").Unprotect


errorCount = Range("R5").Value
Set showErrorCell = Range("S5")


'Check for errors.
    If errorCount > 0 Then
    'Error!
      
    'Tell the user how many errors there are.
    MsgBox errorCount & " Error(s)" & " Gegevens nog invullen"
    
    Range("H5").Select
        
    'Allow conditional formatting for errors to be displayed.
    showErrorCell.Value = 1
     Worksheets("Verkoopfactuur").Protect
     
        Else
          'NO Error - All Good!
          
         ' Call the macro to Store de Factuur.
        Call PDF_Boeken_Nieuw
 
        'Turn conditional formatting for errors off.
        showErrorCell.Value = 0
    
    End If
     
     'protect the Worksheet
    Worksheets("Verkoopfactuur").Protect
  
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan