CODEWITHSUNDEEP
excelvbaimage
syrsln
syrsln

Reputation: 13

How to select multiple pictures on Excel and changing them with VBA

The problem is : I am using Tanex TW2021 label on my work and it has 21 cells, and each cell has one photo (customer's private label)

As each product has its own label, I have to change those pictures one by one (because Excel does not allow to change multiple selection of pictures)

So I want a button which makes this selection of 21 pictures and change all of them with one click.

Below you can see a sample picture of how it looks like...

The Label

I have tried this small code, it selects the pictures (as you will see there "Resim" but does not change them.

Range("A2").Select
ActiveSheet.Shapes.Range(Array("24 Resim")).Select
ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim")).Select 
ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim", "26 Resim")).Select 
ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim", "26 Resim", _ "27 Resim")).Select 
ActiveSheet.Shapes.Range(Array("24 Resim")).Change

Upvotes: 1

Views: 2461

Answers (3)

CDP1802
CDP1802

Reputation: 16189

Assuming you have a single sheet with all 21 images on then delete in turn the existing ones and create new ones the same size in the same place with the new image. See answers here

Option Explicit

Dim FSO As Object, fd As Object, ar() As String
    Dim ws As Worksheet, img As Shape, img2 As Shape, sImageFile As String
    Dim n As Integer, w As Single, h As Single, x As Single, y As Single

    ' select image file
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .InitialFileName = ThisWorkbook.Path
        .InitialView = msoFileDialogViewList
        .AllowMultiSelect = False
    End With

    If fd.Show <> -1 Then
        Exit Sub
    End If
    sImageFile = fd.SelectedItems(1)

    'Update Sheet1
    ReDim ar(100)
    Set ws = ThisWorkbook.Sheets(1)
    For Each img In Sheet1.Shapes
        ' exclude buttons
        If InStr(1, img.Name, "button", vbTextCompare) = 0 Then
            ' existing label
            x = img.Left
            y = img.Top
            w = img.Width
            h = img.Height
            ' delete existing
            img.Delete
            ' create new in same place
            Set img2 = ws.Shapes.AddPicture(sImageFile, msoFalse, msoTrue, x, y, w, h)
            ar(n) = img2.Name
            n = n + 1
        End If
    Next
    ReDim Preserve ar(n - 1)
    Sheet1.Shapes.Range(ar).Select ' select all
    MsgBox n & " images changed", vbInformation, sImageFile
End Sub

Upvotes: 1

Variatus
Variatus

Reputation: 14373

In VBA, a picture is an "object". In Windows, a picture is in a file. You can use Windows Explorer to browse for a picture file. In this thread you can learn how to assign a picture file to a VBA object.

View the vba object as a container. You can put one picture into it or another (but not two), just by changing the file name that you assign to it. In the code

Set p = ActiveSheet.Pictures.Insert(PictureFileName)

the object is called p and the PictureFileName is a variable holding a file name. By changing the file name p will hold a different picture.

Your Tanex software creates one label, probably as something like an outside wrapper containing both the picture object and text. It then multiplies that wrapper 21 times. That process is not part of Excel. From your code it appears like the "wrapper" is an Excel "Shape" or perhaps a collection of 21 shapes. Since you can select the shape you can also access its components. You just have to try out how to do it. Perhaps the picture itself is the "Shape" (a shape is also a VBA object). It might also be an InlineShape which is a particular type of Shape.

This code (courtesy of MrExcel.Com) shows you how to assign a picture file to an existing shape.

With ActiveSheet.Shapes("Oval 7").Fill
    .UserPicture "C:\Users\RickXL\Pictures\HW Diagrams\Gigaport.png"
End With

Replace the shape name "Oval 7" with a name like "Resim 24" in your project. The following code might give you the name of the file of the existing picture which you want to replace.

Msgbox Activesheet.Shapes("Resim 24").Fill.UserPicture

Your label program probably groups the labels into an array. I don't know. You will just have to apply what you know and what I tell you here plus what you can research on the web and find the solution through trial and error. Good luck.

Upvotes: 0

syrsln
syrsln

Reputation: 13

I have tried this small code, it selects the pictures (as you will see there "Resim" but does not change them.

'''Range("A2").Select ActiveSheet.Shapes.Range(Array("24 Resim")).Select ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim")).Select ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim", "26 Resim")).Select ActiveSheet.Shapes.Range(Array("24 Resim", "25 Resim", "26 Resim", _ "27 Resim")).Select ActiveSheet.Shapes.Range(Array("24 Resim")).Change'''

Upvotes: 0

Related Questions