View Single Post
 
Old 08-20-2017, 10:09 AM
DIMI DIMI is offline Windows 7 32bit Office 2007
Advanced Beginner
 
Join Date: Aug 2017
Posts: 37
DIMI is on a distinguished road
Default

Quote:
Originally Posted by NoSparks View Post
Perhaps this...
Code:
Sub SaveInvWithNewName()

    Dim NewFN
    Dim variable1
    Dim variable2

With ActiveSheet    '<~~ this is the original invoice

    ' are these cells filled in?
    If .Range("F16") = "" Or .Range("E31") = "" Or .Range("G31") = "" Then
        MsgBox "some stuff missing"
        Exit Sub
    End If
    
    variable1 = .Range("A32").Value
    variable2 = .Range("A35").Value
    .Copy   'creates new active workbook containing this invoice
End With

With ActiveSheet    '<~~ now dealing with sheet in newly created workbook
    .Range("A32").Value = variable1
    .Range("A35").Value = variable2
    .Cells.Locked = True
    .Protect
    NewFN = "C:\invoice\" & .Range("I5").Value & .Range("H5").Value & .Range("I49").Value & .Range("F16").Value
End With

With ActiveWorkbook
    .SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook    '<~~ this will add the file extention .xlsx
    Application.DisplayAlerts = True
    .PrintOut From:=1, To:=1, copies:=2
    .Close SaveChanges:=False
End With
    
    Call NextInvoice

End Sub
Thank you for your help.
Because I want to make a first check on whether there are empty cells and send me a message and make me POSTTOREGISTER, I tried to adapt your own (I do not know if I put it at the right point) but it is a problem of drafting and finally I think that Locking the new spreadsheet does not succeed if there is any other way or is it better to save it as a pdf (I tried it but when I open it I get a message that the file is corrupted

Sub PostToRegister()
Dim Lrow As Long
Lrow = Sheets("LIST INVOICE").Cells(Rows.Count, 1).End(xlUp).Row
Dim inDate As Date, inNum As Long
inDate = Sheets("INVOICE").Cells(38, 7).Value
inNum = Sheets("INVOICE").Cells(5, 9).Value
Dim exDate, exNum As Long
exDate = Sheets("LIST INVOICE").Cells(Lrow, 1).Value
exNum = Sheets("LIST INVOICE").Cells(Lrow, 2).Value


If .Range("F16") = "" Or .Range("E31") = "" Or .Range("G31") = "" Or .Range("G38") = "" Then
MsgBox "some stuff missing"
Exit Sub

End If


If inDate >= exDate And inNum > exNum Then
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("INVOICE")
Set WS2 = Worksheets("LIST INVOICE")
'Figure out which row is the next row
NextRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1

'Write the important values to Register
'Write the important values to Register
WS2.Cells(NextRow, 1).Resize(1, 6).Value = Array(WS1.Range("G38"), WS1.Range("I5"), WS1.Range("H5"), _
WS1.Range("F16"), WS1.Range("G31"), WS1.Range("E31"))


Else
MsgBox "ERROR"
End
End If
End Sub
Reply With Quote