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 09:55:04 -0400

James, your welcome 

-- 
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:4Z0Wc.25010$UYx.22159@twister01.bloor.is.net.cable.rogers.com...
> Hi Paul,
>
> Thank you very much for your assistance with this code, it works
perfectly!
> I responded to the group on the 20th asking for further assistance because
> it didn't work.
>
> I am very grateful for your help Paul.
>
> Best regards,
>
> James Norton
>
>
> "Paul B" <newspab@surfbest.net> wrote in message
> news:%23SoquQEiEHA.2540@TK2MSFTNGP10.phx.gbl...
> > 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
> > >
> > >
> > >
> >
> >
>
>