PDA

View Full Version : excel vba macros help needed



skmyim
05-08-2017, 03:23 AM
Following issue:

we have an Excel sheet with the following macros.
two Buttons
one for getting new Rechnung Number
and the other Button Speichern unter

all works fine,
but 1 issue
if i push the button new Rechnung Number, it works.
but if i no save the sheet it increases the Rechnung number, which should not be, only if i Save it should increase the Rechnungs number.
Any ideas how to solve it?




Sub NextInvoice()
Dim value As String
ThisWorkbook.Sheets("Sheet4").Range("A1").value = ThisWorkbook.Sheets("Sheet4").Range("A1").value + 1
value = ThisWorkbook.Sheets("Sheet4").Range("A1").value
Range("C18").value = value
Range("A29:H36").ClearContents
End Sub
Sub SaveInvoice()
Application.DisplayAlerts = False
Dim NewFn As Variant
ActiveSheet.Copy
NewFn = "C:\Rechnung\" & Range("C18").value & ".xlsx"
ActiveWorkbook.SaveAs NewFn, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Worksheets("Rechnung").Range("C18").ClearContents
End Sub
Sub Auto_Open()
myRoutine
End Sub
Sub myRoutine()
Worksheets("Rechnung").Range("C18").ClearContents
End Sub

Bob Phillips
05-08-2017, 03:49 AM
Why not ditch the Next Invoice button and just increment the counter in the Save As procedure?

skmyim
05-08-2017, 04:35 AM
Hello Xld,

issue is:

when they open the excel sheet,
first they push button new number
to get the number, ( to see the number )

and the start writing and sometimes they not
finish it, so they just delete the number and close.

what is the smartest solution?
thx

Bob Phillips
05-08-2017, 06:29 AM
If it were me, rather than getting them to push the button, just put the next number in a cell somewhere that they can see, highlight it and so on, but don't let them increment it. The less they do, the less they can do wrongly.

skmyim
05-08-2017, 11:27 AM
Issues almost solved
1 last Thing
NewFn = "C:\Rechnung\" & Range("C18").value & ".xlsx
if path not exists then save to "D:\Rechnung\" & Range("C18").value & ".xlsx


how to do this?
thanks for it

Bob Phillips
05-08-2017, 11:45 AM
NewFn = "C:\Rechnung\" & Range("C18").Value & ".xlsx"
If Dir(NewFn, vbNormal) = "" Then NewFn = "D:\Rechnung\" & Range("C18").Value & ".xlsx"

skmyim
05-08-2017, 12:17 PM
Hello,

thanks for quick reply,

i tried out, but when path1 exists it does not save there,
it saves on the 2nd path.

the issue should be if path1 not exists it should save on path2.
if path1 exists it should save on path1
what am i doing wrong

thanks

Bob Phillips
05-08-2017, 01:57 PM
Sorry, I think I mis-interpreted the brief. Try this instead


NewFn = IIf(Dir("C:\Rechnung\", vbDirectory) <> "", "C:\Rechnung\", "D:\Rechnung\") & Range("C18").Value & ".xlsx"

skmyim
05-14-2017, 03:40 PM
Sub NextInvoice()
Dim value As String

ThisWorkbook.Sheets("Sheet4").Range("A1").value = ThisWorkbook.Sheets("Sheet4").Range("A1").value + 1
value = ThisWorkbook.Sheets("Sheet4").Range("A1").value
Range("C18").value = value
ClearInvoice
End Sub


Sub ClearInvoice()
Range("A29:G36").ClearContents
Range("F11:F17").ClearContents
Range("A29").value = "Monteur A"
Range("F29").value = "1"
Range("G29").value = "104.4"
Range("F11").value = "******"
Range("B25").value = "***X"
End Sub


Sub SaveInvoiceOffice()
Application.DisplayAlerts = False
Dim NewFn As Variant

ActiveSheet.Copy

'here the first save directory
If Not Dir("***Rechnungen BolligerxRechnungenx", vbDirectory) = "" Then
If Range("C18") <> "" Then
NewFn = "***Rechnungen BolligerxRechnungenx" & Range("C18").value & ".xlsx"
ActiveWorkbook.SaveAs NewFn, FileFormat:=xlOpenXMLWorkbook
AfterSave
Else
MsgBox "Bitte Rechnungsnummer vergeben Herr Erdinc !"
ActiveWorkbook.Close
End If
End If
End Sub


Sub SaveInvoiceHome()
Application.DisplayAlerts = False
Dim NewFn As Variant

ActiveSheet.Copy

'here the first save directory
If Not Dir("E:\Dropbox\Rechnungen Bolliger\Rechnungen\", vbDirectory) = "" Then
If Range("C18") <> "" Then
NewFn = "E:\Dropbox\Rechnungen Bolliger\Rechnungen\" & Range("C18").value & ".xlsx"
ActiveWorkbook.SaveAs NewFn, FileFormat:=xlOpenXMLWorkbook
AfterSave
Else
MsgBox "Bitte Rechnungsnummer vergeben Herr Erdinc !"
ActiveWorkbook.Close
End If
End If
End Sub


Sub Auto_Open()
myRoutine
End Sub


Sub AfterSave()
ActiveWorkbook.Close
ClearInvoice
Worksheets("Rechnung").Range("C18").ClearContents
ThisWorkbook.Save
End Sub


Sub myRoutine()
Worksheets("Rechnung").Range("C18").ClearContents
End Sub



We created this macros above,
3 Buttons
1Button to get new invoice number from sheet 4 ( works )
2 Button Save in Office
3 Button Save in home pc

the files are sync with dropbox and it works fine,
button 2 is when working in Office pc ( NAS Server Qnap,different directories)
button 3 is when working in home pc ( on disk d synch with dropbox,different directories )

in Office pc if i push the button 3 no error Messages Shows up, because Directory not exists, but in home pc if i push the wrong button it Shows.

anybody can help what we do wrong in the macro?

thanks a lot

rlv
05-14-2017, 03:59 PM
When posting VBA code for others to look at, it helps if you do the following:


1. Paste your VBA code into the text area
2. Highlight (select) the code
3. Cick the "#" button.


http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_contrib_faq_item