List of Shapes in a Sheet (Excel 2003, Windows 10)

Topic

New Reply

I’d be very grateful to have a Visual Basic function written that can create a list of shapes (pictures, diagrams etc) in a nominated sheet. I would hope to have a function like:

XShapeList(Sheet,Cell) where Sheet is the text of the required sheet name and Cell is the reference of the top left cell where the list will be placed. An example is

XShapeList(“[myBook.xls]Sheet3”,[Book1]Sheet1!$E$31) which would examine all the shapes in [myBook.xls]Sheet3 and place the vertical list starting from the cell of [Book1]Sheet1!$E$31

The return from XShapeList should be the number of shapes found (including zero) or FALSE if any error occurs.

Background. I use the old Macro language, and I get Microsoft Word documents sent to me that I need to analyse. Some of the photos in this document have names longer than 32 characters and I cannot get these names. XShapeList (as above) should resolve the problem for me. My Visual Basic skills are not good. If grouped shapes are found, only the top group name is necessary.

If you have any further suggestions to get an excellent solution I’d be most interested.

Regards

Reply | Quote

Replies

Antediluvian,

This doesn’t do everything you want but it should get you started with the concepts.

Code:

Option Explicit

Sub ListShapes(Source As String, Dest As String)

   Dim shp      As Shape
   Dim Count    As Integer
   Dim wkbSrc   As Workbook
   Dim shtSrc   As Worksheet
   Dim wkbDst   As Workbook
   Dim shtdst   As Worksheet
   Dim vFSParts As Variant
   
   vFSParts = Split(Source, "!")
   
   Set wkbDst = ActiveWorkbook
   Set shtdst = wkbDst.Sheets(Dest)
   
   Set wkbSrc = Workbooks.Open(Filename:=vFSParts(0))
   Set shtSrc = wkbSrc.Sheets(vFSParts(1))
   
   Count = 0
   For Each shp In shtSrc.Shapes
      Count = Count + 1
      shtdst.Cells(Count + 1, 1) = shp.Name
   Next shp
   
   wkbSrc.Close SaveChanges:=False
   
   shtdst.Cells(1, 1) = Count
   
End Sub  'ListShapes

Sample Call:

Code:

Sub Test()

ListShapes Source:="G:BEKDocsExcelTestRandomShapes.xlsx!Sheet1", Dest:="ShapeList"

End Sub

Workbook with Shapes:
46513-ShapeFIle

Code Output:
46514-ShapeListSht

Zip File with the test files: 46515-Excel-VBA-ListShapes
HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Dear RetiredGeek,

Thank you for your input. Unfortunately it does not work for me at this stage. I seek your help as my VB skills are not up to this. I’ve attached my test system. Would it be possible to have the worksheet identified as [book]sheet ? If not I can adjust it externally. I also wish to remove the open statement as the workbook will always be open, and I do not wish to close the file. Therefore the path is not needed. Could the Destination be a cell anywhere in an open workbook please. (If it would be better for you, having the Destination as a single cell Range would be fine.)

I feel I probably have the skills to convert your work into a function and to ensure that it can only fail via a FALSE return.

Regards

Reply | Quote

Antediluvian,

Following RG’s lead, I modified his code slightly to meet your requirements. You didn’t specify which of the workbooks, or even a third external workbook, would contain the code so the modifications are generic to accept any scenario.

HTH,
Maud

Code:

Option Explicit

Sub XShapeList(Source As String, Dest As String)
[COLOR=”#008000″]’——————————————-
‘DECLARE AND SET VARIABLES[/COLOR]
   Dim shp          As Shape
   Dim Count        As Integer
   Dim wkbSrc       As Workbook
   Dim shtSrc       As Worksheet
   Dim wkbDst       As Workbook
   Dim shtdst       As Range
   Dim wkbSrcName   As String
   Dim wsSrcName    As String
   Dim wkbDestName  As String
   Dim wsDestName   As String
   Dim wsDestRng    As String
[COLOR=”#008000″]’——————————————-
‘SOURCE WORKBOOK[/COLOR]
   wkbSrcName = Split(Split(Source, “]”)(0), “[“)(1)
   wsSrcName = Split(Source, “]”)(1)
   Set shtSrc = Workbooks(wkbSrcName).Worksheets(wsSrcName)
[COLOR=”#008000″]’——————————————-
‘DESTINATION WORKBOOK[/COLOR]
   wkbDestName = Split(Split(Dest, “]”)(0), “[“)(1)
   wsDestName = Split(Split(Dest, “]”)(1), “!”)(0)
   wsDestRng = Split(Dest, “!”)(1)
   Set shtdst = Workbooks(wkbDestName).Worksheets(wsDestName).Range(wsDestRng)
[COLOR=”#008000″]’——————————————-
‘COUNT AND IDENTIFY SHAPES[/COLOR]
   Count = 0
   For Each shp In shtSrc.Shapes
      Count = Count + 1
      shtdst.Offset(Count, 0) = shp.Name
   Next shp
   shtdst = Count
[COLOR=”#008000″]’——————————————-
‘CLEANUP[/COLOR]
   Set shp = Nothing
   Set wkbSrc = Nothing
   Set shtSrc = Nothing
   Set wkbDst = Nothing
   Set shtdst = Nothing
End Sub  [COLOR=”#008000″]’ListShapes[/COLOR]


Sub Test()
    XShapeList “[myBook.xls]Sheet3”, “[XShapeTest01.xls]Sheet2!$B$37”
End Sub

Reply | Quote

Dear Maudibe,

That looks great to me, and thank you very much. It worked for me. I obviously exaggerated my VB skills, as most of your code I could not have done myself. That hopefully will give me the opportunity to turn it into a function, and to ensure it reports failures as FALSE.

Regards

Reply | Quote

Thanks Antediluvian but RG did the heavy lifting on this one while I just did the tweak.

Maud

Reply | Quote

My thanks to both of you. I’ve converted your work into a function, the code for which is attached:

XShapeList(Sheet,Target) eg XShapeList(“[myBook.xls]Sheet5″,”[Book7]Sheet1!C74”)

XShapeList returns either the number of shapes in the list or FALSE if any error occurs. It also generates the list of shapes in Sheet and puts that vertical list at the cell starting at Target. Note that the number of shapes is NOT included in the list itself. I need the generality as I don’t know in advance where Sheet or Target will be.

Would the code be more elegant if Target was a reference rather than text?

Again, thank you.

Regards

Reply | Quote

Antediluvian,

Your conversion was nicely done. Yes, I would agree that if Target (or Dest) was a reference instead of a string, the code would be more elegant as there would be no need to break down the components. However, the code does work as is but it is up to you what works best because you will be providing the Target or Destination string/range for the function. If you have a source that outputs the destination as a string then you can certainly keep things the way they are. If your source can output the destination as a range with little or no additional effort, you may consider slight modifications to the function for easier maintenance down the road.

IMHO, whatever provides the smoothest workflow is the path I would take. If you do decide to supply the target as a range instead and run into any problems, RG, myself, or the entire forum is here to assist you.

Maud

Reply | Quote

Dear Maudibe,

Thank you for your kind words, and generous encouragement.

I’ve found what appears to be a problem. XShapeList works fine for normal sheets but not for macro sheets, either as the Source or the Destination. I’ve attached a copy of my test system, the original XShapeList and the test procedures, all of which are also contained in the test system. I found even doing this a bit of a struggle! I know that Visual Basic can write to macro sheets. Perhaps converting Destination to a reference might ease the problem and enable a solution. I would very much appreciate your help on this one. It would be rather tricky for me not to be able to write to macro sheets, i.e. I would very much like to be able to have Destination on macro sheets. At a pinch I could live with shapes being unable to be listed when those Shapes are on macro sheets as I have more control over the names of shapes in that environment, and could list them using other techniques.

Kind regards

Antediluvian

Reply | Quote

Would you consider migrating your macros from a macro sheet to VBA?

Reply | Quote

Maudibe,

Thank you for your suggestion but it would be hard to implement in practice. I have a library of macro language facilities thousands of lines long written over many years that support very many and diverse applications. Where necessary kind people have enhanced that with Visual Basic functions. That would be very hard to change.

I’ve attached such an enhancement and have tested this to show it is possible to read and write to a macro sheet within Visual Basic. Perhaps this could be used to convert the Destination to be a range and thus write to that range. What I could do is to use this new facility in normal sheets that contain shapes (and that write to macro sheets) and use my current facility with macro sheets that contain shapes. I can control the macro sheet environment. The reason I have this problem is that a user sends me information that contains multiple images with names (of images) greater than 32 characters. These images are often megabytes in size! So he and I have a problem that I’m attempting to resolve!

Regards

Antediluvian

Reply | Quote

Very well….let me know if I can be of any more assistance.

Maud

Reply | Quote