Goedendag,
Ik heb op mijn USBstick een Excel macro om facturen te maken, op te slaan, nummeren, printen enz.
Deze facturatie tooltje gebruiken ik en mijn zwager, ieder op ons eigen pc
Bestaat er een VBA code die automatisch opslaat op de usb stick, op welke computer de usb stick ook maar ingeplugd is?
Het "Mijnpad" op mijn pc is "G:\
Wanneer de usb stick in de computer mijn zwager zit start deze vanaf locatie "D:\
Option Explicit
'tekst waarmee factuurnummer begint
Const MijnPad = "G:\Facturen\2015\" 'directory waar de facturen staan
Sub factuuropslaan()
Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
Dim Omschr As String
Omschr = "F" & Year(Date) & "-" 'zoek naar factuurnrs van het huidige jaar
Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
c1 = Dir(Pad & Omschr & "*.xls*") 'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
Do Until c1 = "" 'zoeken tot je alle files langsgelopen hebt
x = Replace(c1, Omschr, "") 'verwijder omschrijving
i = InStr(1, x, ".xls") 'nu nog de file-extensie
If i > 0 Then x = Left(x, i - 1)
If IsNumeric(x) Then 'is wat overblijft nog numeric
Nr = WorksheetFunction.Max(Nr, CInt(x)) 'zoek hoogste nummer tot nogtoe
End If
c1 = Dir
Loop
Naam = Omschr & Format(Nr + 1, "000") 'naam van de factuur (voor het geval je max. 999 facturen per jaar maakt
[Invulblad!D13].Value = Naam
ActiveSheet.SaveAs Pad & Naam & ".xls"
'Application.DisplayAlerts = True
' MsgBox "Relatie opslaan"
' Application.Run ("Relatiebeheer")
MsgBox " ** LET OP ** NU GAAN WE PRINTEN ACTIVEREN"
Application.Run ("FactuurPrinten")
Workbooks.Open (Pad & "Origineel factuur.xls")
ThisWorkbook.Close True
End Sub
Ik heb op mijn USBstick een Excel macro om facturen te maken, op te slaan, nummeren, printen enz.
Deze facturatie tooltje gebruiken ik en mijn zwager, ieder op ons eigen pc
Bestaat er een VBA code die automatisch opslaat op de usb stick, op welke computer de usb stick ook maar ingeplugd is?
Het "Mijnpad" op mijn pc is "G:\
Wanneer de usb stick in de computer mijn zwager zit start deze vanaf locatie "D:\
Option Explicit
'tekst waarmee factuurnummer begint
Const MijnPad = "G:\Facturen\2015\" 'directory waar de facturen staan
Sub factuuropslaan()
Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
Dim Omschr As String
Omschr = "F" & Year(Date) & "-" 'zoek naar factuurnrs van het huidige jaar
Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
c1 = Dir(Pad & Omschr & "*.xls*") 'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
Do Until c1 = "" 'zoeken tot je alle files langsgelopen hebt
x = Replace(c1, Omschr, "") 'verwijder omschrijving
i = InStr(1, x, ".xls") 'nu nog de file-extensie
If i > 0 Then x = Left(x, i - 1)
If IsNumeric(x) Then 'is wat overblijft nog numeric
Nr = WorksheetFunction.Max(Nr, CInt(x)) 'zoek hoogste nummer tot nogtoe
End If
c1 = Dir
Loop
Naam = Omschr & Format(Nr + 1, "000") 'naam van de factuur (voor het geval je max. 999 facturen per jaar maakt
[Invulblad!D13].Value = Naam
ActiveSheet.SaveAs Pad & Naam & ".xls"
'Application.DisplayAlerts = True
' MsgBox "Relatie opslaan"
' Application.Run ("Relatiebeheer")
MsgBox " ** LET OP ** NU GAAN WE PRINTEN ACTIVEREN"
Application.Run ("FactuurPrinten")
Workbooks.Open (Pad & "Origineel factuur.xls")
ThisWorkbook.Close True
End Sub