garak0410
New Member
- Joined
- Jan 27, 2015
- Messages
- 10
- Office Version
- 365
- Platform
- Windows
This may be a hard one to get assistance with but going to try...
One of our main production spreadsheets has a massive amount of code behind it. It has been pieced together for years and I've only made changes when needed. I try not to touch it.
I worked on some code that changes the logo on the sheet when we need to use one of our 10+ private label customers. Here's the code...
This works fine...however, it had a cascading effect on the other code (too huge to post here) that affected protected sections of the workbook. I had to go in and kind of hunt and peck where to insert these and I got it working...however, it doesn't put back the proper "protections" we need, which are:
These protections were set manually in the sheet for years but because the code above has to unprotect and then re-protect, how can I code those settings?
Thanks!
One of our main production spreadsheets has a massive amount of code behind it. It has been pieced together for years and I've only made changes when needed. I try not to touch it.
I worked on some code that changes the logo on the sheet when we need to use one of our 10+ private label customers. Here's the code...
VBA Code:
Option Explicit
Public Sub ImagePicker()
Dim sht As Worksheet, shp As Shape
Dim file As String
Dim fd As FileDialog
Dim t As Single, l As Single, w As Single, h As Single
' get some images
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.InitialFileName = "\\fileserver\drafting\logos\"
With .Filters
.Clear
.Add "Images", "*.ani;*.bmp;*.gif;*.ico;*.jpe;*.jpeg;*.jpg;*.pcx;*.png;*.psd;*.tga;*.tif;*.tiff;*.webp;*.wmf"
End With
If .Show = -1 Then
file = .SelectedItems(1)
End If
End With
'change images on each sheets
If Len(file) <> 0 Then
On Error Resume Next
For Each sht In ThisWorkbook.Sheets
sht.Activate
sht.Unprotect
Set shp = sht.Shapes("CoLogo")
If Not Err Then
With shp
t = .Top
l = .Left
w = .Width
h = .Height
.Delete
End With
sht.Pictures.Insert(file).Select
With Selection
With .ShapeRange
.LockAspectRatio = 0
.Name = "CoLogo"
.Top = t
.Left = l
.Width = w
.Height = h
End With
End With
End If
sht.Protect
Err.Clear
Next
End If
Sheets(1).Activate
End Sub
This works fine...however, it had a cascading effect on the other code (too huge to post here) that affected protected sections of the workbook. I had to go in and kind of hunt and peck where to insert these and I got it working...however, it doesn't put back the proper "protections" we need, which are:
These protections were set manually in the sheet for years but because the code above has to unprotect and then re-protect, how can I code those settings?
Thanks!