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

voorkomen dat bestand overschreven wordt

Status
Niet open voor verdere reacties.

Gerald Baalhuis

Gebruiker
Lid geworden
14 jan 2006
Berichten
369
Beste forumleden,

Met wat speur- knip en plak werk heb ik het volgende in VBA gemaakt:

Code:
Private Sub Workbook_Open()

Cells(9, 4).Select
nr = ActiveCell.Value
nr = nr + 1
ActiveCell.Value = nr

Dim factuurnr%
  Workbooks.Open Filename:= _
    "C:\Documents and Settings\gebruiker\Bureaublad\boekhouding\2007\factuurnr.xls"
  [A1] = [A1] + 1
  factuurnr = [A1]
  ActiveWorkbook.Save
  ActiveWindow.Close
  [A1] = factuurnr
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ThisWorkbook.ReadOnly Then
ThisWorkbook.SaveAs Filename:="C:\Documents and Settings\gebruiker\Bureaublad\boekhouding\2007\nota" & Worksheets("Blad1").Range("c9").Value & ".xls"
End If
End Sub

Nu zou ik ook graag nog een controle inbouwen op het moment van opslaan. Deze controle zou moeten controleren of er al een bestand met de naam die bij het opslaan van het huidige document door VBA aangemaakt wordt, al bestaat en zonodig een melding geeft of (nog mooier) het bestand dat opgeslagen moet worden van een nieuwe naam voorziet.

Kunnern jullie hier iets mee, of is een voorbeeldje handiger?

Gerald
 
Laatst bewerkt door een moderator:
Gerald,

Voor het opslann van een factuur heb ik, met hulp van anderen hier, de volgende routine gemaakt. De kans dat klantnummer en datum al bestaan is klein:

Code:
Sub fact_opslaan()
'
' fact_opslaan Macro
' De macro is opgenomen op 4-1-2006 door rdg.
'

'
' Eerst alle formules uit de factuur halen.
    Range("B9:L53").Select
    Range("L9").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
' Nu opslaan met factuurnummer - debiteurnummer.
    Dim MyNaam
    MyNaam = Range("d15").Value & " - " & Range("e16").Value
    ChDir "C:\firmanaam\Facturen"
    ActiveWorkbook.SaveAs Filename:=MyNaam & ".xls"

Misschien heb je hier iets aan.

Groet,
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan