password protection paramenters

[clayton]

Hello, I want to be able to unprotect my sheet, add a wordart graphi
and reprotect my sheet. The problem I am having is when I do this wit
code the file is protected with the default parameters selected. I wan
to be able to enable wordart so I can insert a wordart object and the
protect the sheet again.
I want to get around the user being able to just delect the added wor
art.
When protected I would like the following parameters to be set:

Allow users to

select locked cells
select Unlocked cells
format cells
format rows

Its the "edit objects" parameter that needs to be enabled for me to ad
a wordart object.


This is what I have so far.

Private Sub CommandButton3_Click()
response = MsgBox("This document will be stamped COPY. ", _
vbYesNo)

If response = vbYes Then


Set myDocument = ActiveSheet
Set myWatermark = myDocument.Shapes.AddTextEffect( _
PresetTextEffect:=msoTextEffect1, _
text:="Draft", _
FontName:="Arial Black", _
FontSize:=100, _
FontBold:=False, _
FontItalic:=False, _
Left:=218.75, _
Top:=159.75)
With myWatermark
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 55
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront

End With
Dim strClient As String
'Dim csPATH As String

strClient = Application.InputBox("Enter your file name")

Const csPATH As String = "c:\"
ActiveWorkbook.SaveCopyAs csPATH & Trim(strClient) & " PO For
Copy.xls"
MsgBox strClient & " PO Form Copy.xls has been saved to C:\"

ElseIf vbNo Then
Exit Sub
End If


Also, is there a way to have it prompt the user for a path? Like
browse button so they can save it where they would like?
Thanks for ANY help

 

[Robert Rosenberg]

I'm assuming you have Excel 2002 or 2003.

Here's code that will unprotect the sheet (assuming a password of "xxx"),
then a placeholder for your add WordArt object code, then reprotect with a
password and the parameters you suggested:

ActiveSheet.Unprotect Password:="xxx"
'Add the WordArt graphic here
ActiveSheet.Protect Password:="xxx", DrawingObjects:=True,
Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True

DrawingObjects:=True will prevent users from deleting any graphic.

Below is a routine that prompts the user for a filename, then save a copy
using the name (and location) along with your PO Form text as part of the
name:

Sub SaveCopyExample()

Const szFILE_NAME_END As String = " PO Form Copy"

Dim szFileName As String

szFileName = Application.GetSaveAsFilename(, "Excel Files
(*.xls),*.xls", , "Save PO Form")

If szFileName <> "False" Then
'Pull out the ".xls" and add "PO Form Copy" to the end and then
re-add the xls extension
szFileName = Left$(szFileName, Len(szFileName) - 4) &
szFILE_NAME_END & ".xls"

'Save the filename
ActiveWorkbook.SaveCopyAs szFileName
End If

End Sub

 

[clayton]

THANKS!
THis works well with only a couple of exceptions...
Normally when you do a Save as you will close the original and leav
you in the saved as file. Your script is working perfectly but I woul
like for them to actually be IN the saved file after they do the Sav
As.
As it is now it is leaving the graphic on the master sheet after you d
a save as. I know its probably something very simple but I am very ne
to all of this and you guys are SO GOOD!
Thanks for your help

 

[clayton]

Well, I have most of what I need sorted out. Since doing a SaveAs in VB
does not leave you in the saved file I am in need of a way to reopen
the file that was just saved. I can close the existing file but how can
i open the last saved file at the same time?

If the SaveAs function would work the save as going to the file menu
and choosing File, SaveAs then all would be fine...

 

[Dave Peterson]

Take a look at Robert's code once more. He didn't actually use .SaveAs. He
used .savecopyas:

ActiveWorkbook.SaveCopyAs szFileName

If you used that code, try changing it to .saveas and see what happens.