PDA

View Full Version : Excel - Identify Shapes by Content



trackmike
02-10-2017, 01:16 PM
You guys have helped me in the past with already solved problems, thank you! This time, however, I haven't been able to find a solution yet.

I have spreadsheets with a number of 16x16 .bmp shapes. Some examples are a red checkmark, a blue checkmark, or a red A with a circle around it. I would like to only delete the checkmarks, while leaving the other shapes intact. Before, the addin we use to insert the shapes would include the file name as alternative text, so I used to use that to differentiate the shapes. However, a software update removed that feature. The shapes are not given identifying names either; just a sequential "Picture 1", "Picture 2", etc. As far as I can tell, Excel does not maintain any information about the source of the shape once it is inserted.

Is there any way I could generate a unique identifier for the different shapes? Some function where, say, running the red checkmark returns "0465", and the red circled A would return "9210", and I could use that identifier to delete only the checkmarks? Or have I missed some method of identifying the source of the .bmp used to insert the shape?

Kenneth Hobs
02-10-2017, 02:53 PM
Welcome to the forum!

Attach a file so that we can test. Click the Go Advanced button in lower right of a reply, then the Manage Attachments hyperlink below the reply box, and then Browse and Upload.

trackmike
02-10-2017, 03:06 PM
Thanks Kenneth! I've uploaded a test file containing two examples to be deleted, and two examples to keep.

Paul_Hossler
02-10-2017, 06:19 PM
I don't think there is any way to reliably tell the shapes apart once they're on the sheet

Maybe by looking upstream and seeing how they're put on the sheet and where they come for, they can be 'tagged' somehow

Please tell us that also

Kenneth Hobs
02-10-2017, 06:24 PM
Doing this as-is may be near impossible as Paul said.

You can use this to see if backgroundstyple would help. After a run, view the results in VBE's Immediate window.

Sub Main()
Dim s As Shape
For Each s In ActiveSheet.Shapes
Debug.Print s.Name,
'https://msdn.microsoft.com/en-us/library/office/ff862530.aspx
Debug.Print s.BackgroundStyle
Next s
End Sub

trackmike
02-10-2017, 08:02 PM
The addin used to insert the images is a third-party program, which is password protected and digitally signed. I can circumvent the password, but I cannot make any changes to the vba project without breaking the digital signature, which then breaks other parts of our software suite if the vba project is unsigned. We also have probably several thousand documents created after the change which broke my old sub. I'll give the background style a try tomorrow!

Would it be possible to break a shape down into its pixels (since they're only 16x16), get the hex color of each pixel, and sum them, or something like that?

Kenneth Hobs
02-10-2017, 08:59 PM
Getting late so I don't have time to explore post #6. I would start with something like this maybe. http://stackoverflow.com/questions/16528319/read-pixel-colors-of-an-image

Paul_Hossler
02-11-2017, 07:59 AM
Would it be possible to break a shape down into its pixels (since they're only 16x16), get the hex color of each pixel, and sum them, or something like that?

I thought of something similar to that, but again I don't think it'd be reliable: someone could stretch the shape accidently, or for all I know the zoom factor might affect the pixel count

trackmike
02-11-2017, 11:25 AM
Okay, I have a semi-solution after following Kenneth's rabbit hole! It works for any zoom level, but resized images do not work. I'm willing to accept a solution that assumes images are not resized. It is a bit slow, taking usually a second or two, but it's much faster than doing it by hand!

I started with the GetPixelColorFromExcelShape module from https://www.mrexcel.com/forum/excel-questions/853661-handler-image-object-getpixel-api-function.html

I then wrote the following (I didn't write the array search myself, I adapted it from some other code I previously found for a related project, but I don't have any source to properly credit I'm afraid):


Sub DeleteAllTickmarks()'
' Keyboard Shortcut: Ctrl+Shift+T
'
If MsgBox("This will delete ALL Engagement checkmarks in this workbook!" & Chr(10) & "All other tickmarks such as PY, A, or 1 will be left intact." & Chr(10) & "Proceed?", vbYesNo, "Confirm Delete") = vbYes Then

Dim Tickmark As Shape
Dim wSheet As Worksheet
Dim ToDelete(2) As String

ToDelete(0) = "42106672"
ToDelete(1) = "44281002"
ToDelete(2) = "42111145"

For Each wSheet In ActiveWorkbook.Worksheets
For Each Tickmark In wSheet.Shapes
'Determine whether or not to delete
'MsgBox (GenerateImageID(Tickmark)) 'Used to find values to delete
If IsInArray(CStr(GenerateImageID(Tickmark)), ToDelete) Then
Tickmark.Delete
End If

Next Tickmark
Next wSheet
End If
End Sub
Function PixelColor(thisShape As Shape, xyCoord As Integer) As Long

Dim tPt As POINTAPI
Dim tPicSize As Size
tPt.x = xyCoord
tPt.y = xyCoord
PixelColor = GetPixelColorFromExcelShape(thisShape, tPt, tPicSize)
End Function


Function GenerateImageID(thisShape As Shape) As Long


Dim shapeSize As Long
Dim primeNumbers(1 To 16) As Long
Dim i As Integer

primeNumbers(1) = 1
primeNumbers(2) = 2
primeNumbers(3) = 3
primeNumbers(4) = 5
primeNumbers(5) = 7
primeNumbers(6) = 11
primeNumbers(7) = 13
primeNumbers(8) = 17
primeNumbers(9) = 19
primeNumbers(10) = 23
primeNumbers(11) = 29
primeNumbers(12) = 31
primeNumbers(13) = 37
primeNumbers(14) = 41
primeNumbers(15) = 43
primeNumbers(16) = 47

shapeSize = 16
GenerateImageID = 0

For i = 1 To 16
GenerateImageID = GenerateImageID + PixelColor(thisShape, i) / primeNumbers(i)
Next i

End Function
Private Function IsInArray(searchVar As Variant, thisArray As Variant) As Boolean
Dim arrayElement As Variant
On Error GoTo IsInArrayError:
For Each arrayElement In thisArray
If arrayElement = searchVar Then
IsInArray = True
Exit Function
End If
Next arrayElement
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function

trackmike
02-11-2017, 11:26 AM
I have to make one more post so I can post the link to the source code I used!