VBA to create check boxes on top of picture objects, on multiple sheet?

[ajjava]

Our ERP generates reports that contain charts. When the reports are exported to Excel, each chart is rendered as a picture object.

I'm looking for a macro that will find each picture object in a workbook and ADD A CHECK BOX IN THE UPPER CORNER. I've added a thick red border around each picture object, for ease of identification in this post.

We send these workbooks out to end-users, who then are required to select which charts they'd like to "keep". I want them to be able to simply check the box for any chart/picture that they'd like to keep.

Can this be done?

I know it would be far easier to put the check boxes in cells NEAR the charts, but since they are grouped so tightly together, there's no good, consistent cell to put them in (and let's operate under the assumption that the end-users are basically clueless in Excel).

[/URL][/IMG]

 

[Domenic]

The following macro assumes that the sheet containing the pictures is the active sheet...

Option Explicit

Sub AddCheckBoxesToPictures()


    Dim targetSheet As Worksheet
    Dim currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long
    
    Set targetSheet = ActiveSheet
    
    If TypeName(targetSheet) <> "Worksheet" Then
        MsgBox "No worksheet is active!", vbExclamation
        Exit Sub
    End If
    
    pictureCount = 0
    For Each currentShape In targetSheet.Shapes
        If currentShape.Type = msoPicture Then
            pictureCount = pictureCount + 1
            With currentShape
                Set currentCheckBox = targetSheet.CheckBoxes.Add(Left:=.Left + 5, Top:=.Top + 5, Width:=45, Height:=18)
                currentCheckBox.Caption = "Check"
            End With
        End If
    Next currentShape
    
    If pictureCount = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
    
End Sub

Hope this helps!

 

[ajjava]

This is perfect. Thank you very, VERY much!!!

 

[ajjava]

Just one more thing - how would i modify this code so that the macro loops through all the sheets in a workbook and ignores the very first picture on each sheet?

 

[Domenic]

Try...

Option Explicit

Sub AddCheckBoxesToPictures()


    Dim currentSheet As Worksheet
    Dim currentShape As Shape
    Dim currentCheckBox As CheckBox
    Dim pictureCount As Long
    Dim pictureCountTotal As Long
    
    If TypeName(ActiveWorkbook) <> "Workbook" Then
        MsgBox "No workbook is active!", vbExclamation
        Exit Sub
    End If
    
    pictureCountTotal = 0
    For Each currentSheet In ActiveWorkbook.Worksheets
        pictureCount = 0
        For Each currentShape In currentSheet.Shapes
            If currentShape.Type = msoPicture Then
                pictureCount = pictureCount + 1
                pictureCountTotal = pictureCountTotal + 1
                If pictureCount > 1 Then
                    With currentShape
                        Set currentCheckBox = currentSheet.CheckBoxes.Add(Left:=.Left + 5, Top:=.Top + 5, Width:=45, Height:=18)
                        currentCheckBox.Caption = "Check"
                    End With
                End If
            End If
        Next currentShape
    Next currentSheet
    
    If pictureCountTotal = 0 Then
        MsgBox "No pictures found.", vbInformation
    End If
    
End Sub

Hope this helps!

 

[ajjava]

PERFECT!!!!! Thanks again!!

 

[Domenic]

You're very welcome!

Cheers!