Open File to Protected

[maperalia]

I have a program that save an excel file then write the file name in a log
file. However, l have been trying to add a program to open the file from the
log. Then protect it and cut the buttons of the macros then save as read only
it and close it. (see program below) . The file from the log is :
Filename = "" & WO & "_" & Tract & "_" & Supplier & "_" & Dates & "_" & Time
& ""
Unfortunately I was unsuccessful to do it.
Could somebody help me to make this program run please

Thanks in advance.
Maperalia

‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Option Explicit
Public Sub SaveAndArchive()
SaveExcelFile
DeleteButtonsAndProtectFile
End Sub




Sub SaveExcelFile()
Dim boError As Boolean
Dim strError As String
Dim Tract As String
Dim WO As String
Dim Supplier As String
Dim Dates As String
Dim Time As String
Dim sFilename As String
Dim Progname As String
Dim Filename As String

strError = ""
boError = False
With Worksheets("Gradation Form")
If .Range("G2") = "" Then
boError = True
strError = strError & "WORK ORDER # "
End If
If .Range("G3") = "" Then
boError = True
strError = strError & "TRACT #"
End If
If .Range("C6") = "" Then
boError = True
strError = strError & "SUPPLIER "
End If
If .Range("G4") = "" Then
boError = True
strError = strError & "DATE "
End If
If .Range("G5") = "" Then
boError = True
strError = strError & "TIME"
End If
If boError = True Then
MsgBox "The Following Ranges have not been Typed Yet - " & strError
Exit Sub
Else
WO = Worksheets("Gradation Form").Range("G2")
Tract = Worksheets("Gradation Form").Range("G3")
Supplier = Worksheets("Gradation Form").Range("C6")
Dates = Worksheets("Gradation Form").Range("G4")
Time = Worksheets("Gradation Form").Range("G5")
Filename = "" & WO & "_" & Tract & "_" & Supplier & "_" & Dates &
"_" & Time & ""
Progname = "C:\Mario\Macro Samples\Excel\Gradation\Gradation Form
Rev1\" & Filename & ".xls"
ActiveWorkbook.SaveCopyAs Progname

Call ListOfFileSave(Filename)



'***************************************************

'SAVE AS AS READ ONLY
SetAttr Progname, vbReadOnly

'***************************************************

End If
End With
End Sub





Sub ListOfFileSave(Filename As String)
Dim nRow As Integer

Workbooks.Open Filename:="C:\Mario\Macro Samples\Excel\Gradation\Gradation
Form Rev1\Gradation Log.xls"
nRow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Cells(nRow, 1) = Filename
ActiveWorkbook.Save
ActiveWindow.Close
End Sub





Sub DeleteButtonsAndProtectFile()
Dim Filename As String
ChDir "C:\Mario\Macro Samples\Excel\Gradation"
Workbooks.Open Filename:= _
"C:\Mario\Macro Samples\Excel\Gradation\"" & WO & "_" & Tract & "_"
& Supplier & "_" & Dates & "_" & Time & "".xls
Range("J1:L36").Select
ActiveWindow.LargeScroll Down:=-1
Range("J1:L36").Select
Selection.ClearContents
Selection.Cut
Columns("J:L").Select
Range("J2").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveSheet.Shapes("Rectangle 14").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 16").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 19").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 21").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 22").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 23").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 24").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 25").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 26").Select
Selection.Cut
ActiveSheet.Shapes("Rectangle 18").Select
Selection.Cut
Range("N22:N23").Select
Range("N23").Activate
Cells.Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1:I1").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

 

[ste]

Ciao,


1)
You can't save a file with the "/" character and seems to me that your
code

Dates = Worksheets("Gradation Form").Range("G4")
.....
Filename = .... "_" & Dates &

does this mistake.

2)
Sub ListOfFileSave(Filename As String)
Dim nRow As Integer
Dim r As Range

Workbooks.Open Filename:=ThisWorkbook.Path & "\Gradation Log.xls"
Set r = Sheets("sheet1").Range("A1").End(xlDown)
nRow = r.Row + 1
Cells(nRow, 1) = Filename
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

3)
Option Explicit
Dim Progname As String

in order to use it in DeleteButtonsAndProtectFile()

4)
Sub DeleteButtonsAndProtectFile()
Workbooks.Open filename:=Progname
.....

is it what you were looking for?

Fammi sapere!

 

[maperalia]

Fammi;
Thanks for your respond.
What I try to achive is the following:

1.- Open the filename (Filename = "" & WO & "_" & Tract & "_" & Supplier &
"_" & Dates & "_" & Time )
2.- Cut the macro's button
3.- Protect all cells
4.- Save it
5.- Close it

The filename varies all the times.
Could you you please help me!!!

Maperalia

 

[ste]

Hello,

1.- Open the filename (Filename = "" & WO & "_" & Tract & "_" &
Supplier & "_" & Dates & "_" & Time )

if filename is = "" & WO & "_" & Tract & "_" & Supplier & "_" & Dates &
"_" & Time & ""
and Progname = YourPath & "\" & filename & ".xls"
you can daclare Progname in the top of your module:
Option Explicit
Dim Progname As String

and use it for your first task



2.- Cut the macro's button


'To delete *all* the shapes:

Private Sub DeleteButtonsAndProtectFile()
Dim S As Shape
Workbooks.Open filename:=Progname

For Each S In ActiveSheet.Shapes
S.Delete
Next
......

3.- Protect all cells
4.- Save it
5.- Close it

move the following code to the end of DeleteButtonsAndProtectFile().
you can't save the modify of DeleteButtonsAndProtectFile() if
the file if already in readonly mode

SetAttr Progname, vbReadOnly


Private Sub DeleteButtonsAndProtectFile()

Workbooks.Open filename:=Progname
Dim S As Shape
For Each S In ActiveSheet.Shapes
S.Delete
Next

With ActiveSheet
.Cells.Locked = True
.EnableSelection = xlNoSelection
.Protect Contents:=True, UserInterfaceOnly:=True
End With

ActiveWorkbook.Close True
SetAttr Progname, vbReadOnly
End Sub

 

[maperalia]

ste;
Thank you very much for your help. The program it is running wonderful!!!!!!!!
I really appreciate your helping.....
Best regards.
Maperalia