αποτροπή επεξεργασίας και μήνυμα οτι έχω ξεχάσει κάτι
 

Καλησπέρα,
Έχω δύο προβλήματα με τον κώδικα: 1) Το έχω ρυθμίσει για να αποθηκεύει ένα αντίγραφο στο σκληρό δίσκο αλλά όταν πάω να βρω το αρχείο μπορώ να το επεξεργαστώ πράγμα που δεν θέλω να το κάνω. Θέλω ακόμα να προστατεύσω το φύλλο excel από τυχον αλλαγές δηλαδη μονο να το βλέπω ή να το αποθηκεύσω ως pdf και 2) Θα ήθελα να μου βγάζει μήνυμα οταν πατάω αποθήκευση οτι τα κελιά F16, E31, G31,δεν έχουν περιεχόμενο.

Ο κώδικας μου είναι:
Sub NextInvoice()
Range("I5").Value = Range("I5").Value + 1
Range("G26").Value = Range("G34")
Range("G30").Value = Range("G34")
Range("G31").MergeArea.ClearContents
Range("G34").MergeArea.ClearContents
Range("G38").MergeArea.ClearContents
Range("E31").MergeArea.ClearContents
Range("G34").Formula = "=G30-G31"

End Sub

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

Sub SaveInvWithNewName()

Dim NewFN
Dim variable1
Dim variable2

With ActiveSheet
variable1 = .Range("A32").Value
variable2 = .Range("A35").Value
.Copy
End With

With ActiveSheet
.Range("A32").Value = variable1
.Range("A35").Value = variable2
End With

With ActiveSheet
NewFN = "C:\invoice\" & Range("I5").Value & Range("H5").Value & Range("I49").Value & Range("F16").Value & ".xlsx"
ActiveSheet.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
ActiveWorkbook.PrintOut From:=1, To:=1, copies:=2
ActiveWorkbook.Close SaveChanges:=False
NextInvoice
End With
End Sub

Sub FINISH()
Call PostToRegister
Call SaveInvWithNewName
End Sub