Detect image and fit row if not

[PIsabel]

Hello.
I'm working on a table of articles with images.
Each line has a fixed height of 100.
I need a code that identifies the lines that do not have an image and that reduces these same lines to a height of 15

Can some help me?

Thanks

 

[skillilea]

Your profile doesn't show it but are you using MS Excel 365?

Are you using the =IMAGE() in Column A

 

[PIsabel]

Yes excel 365.
the image is inserted by a macro

 

[Micron]

And are they images or shapes? AFAIK the only way to detect if a cell contains an image is to loop over the images/shapes and see if the topleftcell row property matches the row of the cell you want to test. That would mean looping over the images collection for every row you want to examine. Seems to me that there ought to be a better way. Maybe using a dictionary or collection? Start out with all the row numbers, then loop over the images collection and remove those row numbers. Then the rows that are left don't contain images, so size those? Or maybe just start with an array of all row numbers that have data and remove items from the array? Then the remaining numbers are rows that don't have images.

 

[PIsabel]

I think they are images but I'm very inexperienced

 

[Micron]

Me too (at least with Excel vba). One way to know if Shapes are involved would be to open the vb editor and in the immediate window type
?sheets("001").shapes(1).topleftcell.row
and hit enter. If you get no error but get a number, look at that row number to see what's there.

I have to go out for the afternoon so I won't be able to follow this until later. The other things I mentioned were ideas that seem doable to me but as I say, practically anything I want to do in Excel vba I have to Google. I do have some foundation, which is Access vba, so that guides me but I'm by no means an expert in Excel vba. So to reiterate on one of those ideas, I might:
- get the last row number that has data
- create an array from row 1 to last row number (or if not 1, then wherever you need to start from)
- loop over the shapes (images?) collection belonging to a sheet
- remove each row number from the array where there is an image by using the shape's .topleftcell.row property
- after that, loop over the remaining array row values and set height property to the value desired.

That's just a rough idea and at this point I have not thought about what the pitfalls might be. If you only have say, 100 rows, you could do this much faster than it can be coded. You can multi select non-contiguous rows (hold ctl and click row numbers) then right click and choose row height... and type in 15.

 

[PIsabel]

I can only make small changes to codes that are available on the internet.
I don't know how to program

 

[Micron]

I can only make small changes to codes that are available on the internet.
I don't know how to program

No problem, as long as you're not in a hurry. I'm pretty busy these days but won't bore you with the sad details. However, I'd like to also see if anyone says my idea(s) are bunk or have any merit before I dive in to anything.

 

[Micron]

Oh, and it would help to know what column could reliably be used to detect which row is the last one with data - B, C or D? Or something else?

EDIT - right click on an image and look at the resulting context (shortcut) menu. If you find Properties, choose that. Look at the property sheet. At the top it will show Image and a number like below. This will confirm it's an image and not a shape.

 

[jolivanes]

Works on your example.

Sub Maybe()
Dim sh1 As Worksheet, shp As Shape, rng As Range, c As Range
Dim lr As Long, j As Long, rw
Set sh1 = Worksheets("Sheet1")
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh1.Range(sh1.Cells(3, 1), sh1.Cells(lr, 1))
Application.ScreenUpdating = False
    With sh1
    For Each c In rng
        For Each shp In .Shapes
            If Not Intersect(shp.TopLeftCell, .Range(c.Address)) Is Nothing Then
                shp.Placement = xlMoveAndSize
                    rw = rw & "|" & c.Row
                Exit For
            End If
        Next shp
    Next c
    End With
    rw = Split(Mid(rw, 2), "|")
    For j = LBound(rw) To UBound(rw)
        sh1.Rows(rw(j)).EntireRow.Hidden = True
    Next j
    With rng
        .SpecialCells(xlCellTypeVisible).RowHeight = 15
        .EntireRow.Hidden = False
    End With
    Application.ScreenUpdating = True
End Sub