vba to make a list of all picture names sizes and sheets?

[tonywatsonhelp]

Hi Everyone,
Not sure if this is posible, but creating a new document with about 90 sheets, every sheet has a picture or two in it, many of which are the same but i'm finding the pictures are not maintining there sizes as i copy paste move design ect. I've done "Do not move or size with picture but i was woundering if there was a macro i could use to check each picture?

if its posible then i'd like this
Sheet1 to collect the data.
every picture in the document to be list as
picture name. sheet name, height, width, and if possible position on sheet but thats no so important.

Any Ideas if this can be done and how?

Thanks
Tony

 

[Yongle]

Try this

- First sheet collects collect the data
- Every picture in the document listed
- List includes picture name. sheet name, height, width, and position on sheet
- Position on sheet interpreted as cell containing top left corner of picture

Option Explicit

Sub ListPictures()
    Dim WsList As Worksheet, Ws As Worksheet, Shayp As Shape, r As Long
    Dim PicName As String, WsName As String, H As Double, W As Double, cel As String

    Application.ScreenUpdating = False    
    Set WsList = Worksheets.Add(before:=Sheets(1))
    r = 1
    WsList.Cells(r, 1).Resize(, 5).Value = Split("Picture,Sheet,Height,Width,Position", ",")
    For Each Ws In ThisWorkbook.Worksheets
        WsName = Ws.Name
        For Each Shayp In Ws.Shapes
            With Shayp
                If .Type = msoPicture Then
                    PicName = .Name
                    H = .Height
                    W = .Width
                    cel = .TopLeftCell.Address(0, 0)
                    r = r + 1
                    WsList.Cells(r, 1).Resize(, 5).Value = Array(PicName, WsName, H, W, cel)
                End If
            End With
        Next Shayp
    Next Ws
End Sub

 

[tonywatsonhelp]

That was exactly what I needed worked first time, thank you Yongle
Tony

 

[Yongle]

feedback appreciated