Phantom Photos: Images Duplicate Themselves Randomly in Excel Files Stored In SharePoint

Hello,

I didn't find a reason for this. I draw a solution, though.

For my specific worksheet I listed in a table which images are "real" and coded a VBA macro that deletes any image not listed there and any duplicated image.

So the steps would be:

1. Tag your images

2. Create a table and list all of them

3. Create a sub and call this sub every worksheet.activate event

Code

Sub DeleteUnlistedAndDuplicateImages()
    Dim ws As Worksheet
    Dim img As Shape
    Dim tbl As ListObject
    Dim tblRange As Range
    Dim nameList As Range
    Dim imgName As String
    Dim foundMatch As Boolean
    Dim imgCount As Integer
    
    'set worksheet to the active sheet
    Set ws = ActiveSheet
    
    'set table to the first table in the worksheet
    Set tbl = ws.ListObjects("tblImages")
    
    'set table range to include only the name column
    Set tblRange = tbl.ListColumns("Image").DataBodyRange
    
    'loop through all shapes in the worksheet
    For Each img In ws.Shapes
        'check if the shape is an image
        If img.Type = msoPicture Then
            'get the name of the image
            imgName = img.Name
            
            'set foundMatch flag to false
            foundMatch = False
            
            'loop through the name column in the table
            For Each nameList In tblRange
                'compare the image name with the name in the table
                If imgName = nameList.Value Then
                    foundMatch = True
                    Exit For
                End If
            Next nameList
            
            'if a match is not found, delete the image
            If Not foundMatch Then
                img.Delete
            Else
                'if a match is found, count the number of times the image appears in the worksheet
                imgCount = 0
                For Each img2 In ws.Shapes
                    If img2.Type = msoPicture And img2.Name = imgName Then
                        imgCount = imgCount + 1
                    End If
                Next img2
                
                'if the image appears more than once, delete all duplicates except for the first one
                If imgCount > 1 Then
                    For i = 2 To imgCount
                        For Each img2 In ws.Shapes
                            If img2.Type = msoPicture And img2.Name = imgName Then
                                img2.Delete
                                Exit For
                            End If
                        Next img2
                    Next i
                End If
            End If
        End If
    Next img
End Sub