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:42:25 -0400

James, text wrap got the other code, copy and paste this one

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 

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