Used Range with objects / pictures ???

[DaLiMan]

Hi,


Is it possible to create a VBA code that accually looks at the used range in a worksheet but also includes the pictures in that sheet?

The standard UsedRange does not work properly and the FindUsedRange from http://www.vbaexpress.com/kb/getarticle.php?kb_id=82 does not include my imported pictures.

Can anyone help me?

Thanx.

 

[pgc01]

Hi

To correct the used range you got, taking into account the shapes in the worksheet:

1 - Get the used range using the code you posted that looks at the values of the cells in the worksheet

2 - Loop through the shapes collection. Look in each shape at the properties TopLeftCell and BottomRightCell to get the 2 opposite corners and correct the used range, if necessary.

 

[DaLiMan]

Thanx for the tip.
After googling and combining some scripts I came up with the code below.
Probably could be more slik, but it works for me.....

Sub UsedRange_withShapes()
    
    Dim FirstRow        As Long
    Dim LastRow         As Long
    Dim FirstColumn     As Integer
    Dim LastColumn      As Integer
     
    On Error Resume Next
     
    FirstRow = Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
     
    FirstColumn = Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
     
    LastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    LastColumn = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    Debug.Print "FirstRow: " & FirstRow
    Debug.Print "FirstColumn: " & FirstColumn
    Debug.Print "LastRow: " & LastRow
    Debug.Print "LastColumn: " & LastColumn
    
    'Set RealUsedRange = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn))
     
    On Error GoTo 0
    
    Dim sh As Shape
    Dim I As Integer
    I = 1
    For Each sh In ActiveSheet.Shapes
        'MsgBox sh.TopLeftCell.Row
        'MsgBox sh.BottomRightCell.Row
        If sh.BottomRightCell.Row > LastRow Then LastRow = sh.BottomRightCell.Row
        If sh.BottomRightCell.Column > LastColumn Then LastColumn = sh.BottomRightCell.Column
    
    Debug.Print "LastRow: " & LastRow
    Debug.Print "LastColumn: " & LastColumn
    
    
    Next
    
Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).Select
End Sub

 

[pgc01]

Hi

I'm glad you solved the problem.

If you don't mind I'll just add some comments:

1 - It's not a good idea to use something like

Range("IV65536")

Then number of rows and columns varies with the excel version and you'll end up with a solution that works in one worksheet and not in the other.
It's better to use instead

Cells(Rows.Count, Columns.Count)

This way it will work for any worksheet (I assumed, like you, that you are working with the active sheet)

2 - You are only adjusting the Right and Bottom of the used range. You should also adjust the Left and Top. Ex.: You may start with a used range C5:F8 but have a picture with the top left corner in A1.

3 - The only thing I did not like in the code. I don't know why you do it, and so you may have a valid reason, but in the last statement of the procedure you select the used range. It's very rare that you select anything in vba. It's usually inefficient, unnecessary and hurts readability.

 

[DaLiMan]

Hi,
Thanx for the comments, always open for it.

1 - Thanx for the suggestion, i'll try it out.

2 - I know it's not complete, but the first line is always the same.
Only the last row / column changes.

3 - Not exactly sure what you mean here, but I use it for copying and pasting in a Lotus Notus mail. Instead of mousing I like clicking a lot more....

Thanx for the help and info, have a nice weekend.
Daniel