Re: How can I add protect/unprotect *** to this code?

From: Paul B (newspab_at_surfbest.net)
Date: 08/22/04 

Date: Sun, 22 Aug 2004 08:33:47 -0400

James, you had two ways to do it in your post on the 19th, did it not work?
one way

Sub test()
Application.ScreenUpdating = False
Active***.Unprotect password:="" ' if you have a password put it between
the "" , like this "mypassword"
Dim i As Integer, p As Picture, r As Range, c As Range, ii As Integer
ii = 1
Set r = Active***.Range("G5:G14")
Active***.DrawingObjects.Delete
For Each c In r
ii = ii + 1
If c <> "" Then
With Application.FileSearch
.NewSearch
.LookIn = "c:\drugpics"
.SearchSubFolders = False
.Filename = "*" & c & ".jpg"
.Execute
For i = 1 To .FoundFiles.Count
With Active***
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles(i))
.DrawingObjects(p.Name).Left = .Columns(ii).Left
.DrawingObjects(p.Name).Top = .Rows(16).Top
.DrawingObjects(p.Name).Width = .Columns(ii + 1).Left - .Columns(ii).Left
.DrawingObjects(p.Name).Height = .Rows(17).Top - .Rows(16).Top
.DrawingObjects(p.Name).Placement = xlMoveAndSize
.DrawingObjects(p.Name).PrintObject = True
End With
Exit For
Next i
End With
End If
Next c
Active***.Protect password:="" ' if you have a password put it between the
"" , like this "mypassword"
Application.ScreenUpdating = True
End Sub

Or from Ron to protect all sheets on open with user interface only, so the
macros will run on the protected ***, put in thisworkbook code, save the
workbook colse it and reopen it, her has the password set as ABCD change to
your password or just use "" for no password, please do not post to more
than one group or start another post, if something does not work just post
back

Private Sub Workbook_Open()
Dim sh As Work***
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
sh.Protect "ABCD", , , userinterfaceonly:=True
Next sh
Application.ScreenUpdating = True
End Sub 

-- 
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2000 & 2003
** remove news from my email address to reply by email **
"James Norton" <jamo@rogers.com> wrote in message
news:zS%Vc.24328$UYx.19085@twister01.bloor.is.net.cable.rogers.com...
> Good day,
>
> I have the code below on my *** and want to keep the page protected
other
> than when this code runs. How can I unprotect at the beginning of this
code
> and then reprotect it at the end. If I don't unprotect before running this
> script I get a error code "400".
>
> Many thanks,
>
> James Norton
>
>
>
> Sub test()
> Application.ScreenUpdating = False
> Dim i As Integer, p As Picture, r As Range, c As Range, ii As Integer
> ii = 1
> Set r = Active***.Range("G5:G14")
> Active***.DrawingObjects.Delete
> For Each c In r
> ii = ii + 1
> If c <> "" Then
> With Application.FileSearch
> .NewSearch
> .LookIn = "c:\drugpics"
> .SearchSubFolders = False
> .Filename = "*" & c & ".jpg"
> .Execute
> For i = 1 To .FoundFiles.Count
> With Active***
> Set p = .Pictures.Insert(Application.FileSearch.FoundFiles(i))
> .DrawingObjects(p.Name).Left = .Columns(ii).Left
> .DrawingObjects(p.Name).Top = .Rows(16).Top
> .DrawingObjects(p.Name).Width = .Columns(ii + 1).Left - .Columns(ii).Left
> .DrawingObjects(p.Name).Height = .Rows(17).Top - .Rows(16).Top
> .DrawingObjects(p.Name).Placement = xlMoveAndSize
> .DrawingObjects(p.Name).PrintObject = True
> End With
> Exit For
> Next i
> End With
> End If
> Next c
> Application.ScreenUpdating = True
> End Sub
>
>
>