Copy/Paste/Insert image into different size textbox in multiple sheets

[QualEng]

Hi

I have a large workbook with a variety of documents the majority of whichhave my company logos as standard but I need to be able to insert the customerlogo into these sheets. The position and size of the logo is different from onesheet to another so pasting to a specific cell is not going to work. I’m hopingsomeone can tell me how to insert the customers logo into a text box on all therequired sheets using VBA, I have tried a number of ways including the codebelow (which is a test for one sheet only) which I have tried to place the logointo a textbox. But I have a number of issues.

1. I can’t get the image to resize to the textbox - makes it the textbox bigger and no longer fits the sheet layout
2. As there a large number of sheets I think I need a common name forthe text box on each sheet so that I can use a “For Each wsheet ….Next wsheet” routine to insert the logo into eachsheet that has the named text box (without changing the text box size). I have triedplacing a text box on a number of sheets with the same name but excel doesn’tseem to allow this?

This workbook is to be used by a number of users in different locationswho may have their folders ordered/named differently. So copy paste from a sheetin the workbook would be my preference. I have tried copy/paste from a sheet inthe workbook rather than from a file location but that wasn’t successful either.

Any suggestions? I would be very grateful for any assistance Thanks

Sub ShapePicture()
Dim TextboxName As String
Dim xSh As Shape
Dim xPic As IPictureDisp
Dim xFileName As String
TextboxName = "TextBox4"
xFileName = "F:\Logos& Graphics\CustomerLogo.JPG"
Set xPic =LoadPicture(xFileName)
Set xSh =Sheets("Section Divider (11)").Shapes(TextboxName)
xSh.Height = xPic.Height /xPic.Width * xSh.Width
Set xPic =LoadPicture("")
Set xPic = Nothing
xSh.Fill.UserPicturexFileName
End Sub

 

[Yongle]

As there a large number of sheets I think I need a common name forthe text box on each sheet so that I can use a “For Each wsheet ….Next wsheet” routine to insert the logo into eachsheet that has the named text box (without changing the text box size). I have triedplacing a text box on a number of sheets with the same name but excel doesn’tseem to allow this?

1. An Active-X TextBox on one sheet can be named the same as an Active-X TextBox on another sheet
(why use textboxes for images? - see 3)

This workbook is to be used by a number of users in different locations who may have their folders ordered/named differently. So copy paste from a sheet in the workbook would be my preference. I have tried copy/paste from a sheet in the workbook rather than from a file location but that wasn’t successful either.

2. Saving images and the workbook into a single folder, zipping that folder and distributting the zipped file is an alternative
Unzipping places the images & workbook in the same folder making ThisWokbook.Path return the correct path for any images
(this may not be required - see 3)

I’m hoping someone can tell me how to insert the customers logo into a text box on all the required sheets using VBA

3. Why use textboxes?
Consider using Active-X image controls instead
Images are embedded in the worksheet
Several of your issues will go away

4. I am guessing that you want to distribute the workbook with all logos
- what I mean by that is that "users" are not adding any logos

 

[QualEng]

1. An Active-X TextBox on one sheet can be named the same as an Active-X TextBox on another sheet
(why use textboxes for images? - see 3)


2. Saving images and the workbook into a single folder, zipping that folder and distributting the zipped file is an alternative
Unzipping places the images & workbook in the same folder making ThisWokbook.Path return the correct path for any images
(this may not be required - see 3)


3. Why use textboxes?
Consider using Active-X image controls instead
Images are embedded in the worksheet
Several of your issues will go away

4. I am guessing that you want to distribute the workbook with all logos
- what I mean by that is that "users" are not adding any logos

Hi
Thanks for that, I'll have a go and see what I can o with Active X boxes.

The people using this workbook are tiered intoHigh Medium and Low level users. The High level users will havepermissions to setup the workbook (including addition of logos) for the Mediumlevel users and the Low level users will only have viewing access.
Thanks again

 

[QualEng]

I have tried using ActiveX image controls and can see how they work manually but my knowledge of VBA is even more limited than I thought and have been unable to get images to load into ActiveX boxes using VBA
My goal is:
Get user to either

1. Copy image to clip board and click button to load to ActiveX boxes

Or

1. Paste image to excel sheet in workbook and then click button to copy/load image from sheet to ActiveX boxes.

Any example code to achieve the above will be very much appreciated

 

[Yongle]

This code can be used to load images to image control

Sub LoadImage()
    Dim fpath As String
    fpath = "C:\Test\jpg\jpegname.jpg"
    Sheets("NameOfSheet").Image1.Picture = LoadPicture(fpath)
End Sub

 

[Yongle]

If you are concerned about other user folders, then ask user to tell VBA where to find an image file

Sub ChooseFolder()
    Dim fldr As FileDialog
    Dim fpath As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo TheEnd
        fpath = .SelectedItems(1)
    End With
TheEnd:
    MsgBox fpath
    Set fldr = Nothing
End Sub

 

[QualEng]

Thanks very much for the code examples. I have managed to get closer to the solution butI'm not quite there yet.

The following code loads an image into the active sheet butthen stops. I’ve tried with and without design mode on/off/sheet protection codeetc. As stand-alone routines each part works but when put together they don’t,except the loop routine which I have used in other areas of the workbook. I havea second looped routine which is to clear the images from the ActiveX boxes butagain this stops after clearing the active sheet.


I have had a quick look and tried the code you posted for selecting the folder but am not sure how it works withthe image load code do I have to call the code from within the load code and how does the result become partof the fpath address?



Sub LoadImage()
Application.ScreenUpdating = False
'Start loop
Dim wsheet As Worksheet
For Each wsheet InActiveWorkbook.Worksheets
'Unprotect sheet
wsheet.Unprotectpassword:="0159"
'Enter design mode
WithApplication.CommandBars.FindControl(ID:=1605)
.Execute
End With
'Load Picture
Dim fpath As String
fpath = "Z:\Logos\WB LOGOFOLDER\Logo.jpg"
ActiveSheet.Image1.Picture =LoadPicture(fpath)
Dim sTemp As String
'Exit design mode
With Application.CommandBars("ExitDesign Mode")
sTemp = .Controls(1).Caption
End With
'Protect sheet
wsheet.Protectpassword:="0159", DrawingObjects:=True, Contents:=True, Scenarios:=True,AllowInsertingHyperlinks:=True
wsheet.EnableSelection = xlNoSelection
Next wsheet
Application.ScreenUpdating = False
End Sub


Sub RemoveLogos()
Dim wsheet As Worksheet
For Each wsheet In ActiveWorkbook.Worksheets
ActiveSheet.Image1.Picture =LoadPicture("")
Next wsheet
End Sub

Thanks again for your help with this.

 

[Yongle]

To add an image control and insert a picture selected by user (filtered to only allow jpg files)

Add a command button to the worksheet

the code below goes in the sheet module

Private Sub [COLOR=#ff0000]CommandButton1[/COLOR]_Click()

    Dim img As OLEObject, fpath As String, cel As Range
'ask user where to place the image
    On Error Resume Next    'required if user selects cancel
    Set cel = Application.InputBox("Select a cell with mouse or enter cell ref in Box", , , , , , , 8).Cells(1)
    If Err.Number > 0 Then GoTo Handling
'ask user to select image
    fpath = ChooseFile
    If fpath = "Cancelled" Then GoTo Handling

'add the image conrol
    Set img = Me.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=cel.Left, Top:=cel.Top, Width:=100, Height:=60)
    
'insert image
    With img.Object
        .Picture = LoadPicture(fpath)
        .PictureSizeMode = fmPictureSizeModeZoom
    End With
    Exit Sub
Handling:
MsgBox "You did not select anything"
End Sub

Private Function ChooseFile() As String

    Dim fname As String, fChosen As Integer
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = Application.DefaultFilePath
        fChosen = .Show
        .Filters.Clear
        .Filters.Add "JPG files", "*.jpg"
         If fChosen <> -1 Then
            ChooseFile = "Cancelled"
         Else
            ChooseFile = .SelectedItems(1)
        End If
    End With
End Function

 

[Yongle]

If the user is required only to add the logo (ie image control already in the sheet)
Private Function ChooseFile is called by this procedure also

Private Sub [COLOR=#ff0000]CommandButton2[/COLOR]_Click()

    Dim img As OLEObject, fpath As String

'ask user to select image
    fpath = ChooseFile
    If fpath = "Cancelled" Then GoTo Handling

'identify image conrol
    Set img = Me.OLEObjects("Image1")
    
'insert image
    With img.Object
        .Picture = LoadPicture(fpath)
        .PictureSizeMode = fmPictureSizeModeZoom
    End With

    Exit Sub
Handling:
MsgBox "You did not select anything"
End Sub

 

[Yongle]

Deleting a picture is not obvious

if image control set to variable img (as in above code)

img.Object.Picture = LoadPicture("")

otherwise

ActiveSheet.Image1.Picture = LoadPicture("")