count shapes

[pit263]

I am trying to figure out how to tell vba to count all the shapes in a document. Afterwards i would like it to select the last (furthest to the right) shape and depending on what page it is, print that many pages.

If anyone could help me here, i would really appreciate it. I know it can't be to complicated but i just don't get it.

Thanks so much
Peter

 

[macropod]

Hi peter,

If you want to find the last shape in the document, about the nearest you'll get is to use code like:

Sub GetLastShape()
Dim i As Integer
With ActiveDocument
  For i = 1 To .Paragraphs.Count
    With .Paragraphs(i).Range
      If .ShapeRange.Count > 0 Then .ShapeRange(.ShapeRange.Count).Select
    End With
  Next i
End Wit
End Sub

I say 'about' because, if the paragraph concerned has more than one shape attached to it, the selected shape may not match your idea of the last shape in he document. Also note that the code works on the basis of which paragraphs the shapes are anchored to. If the shape and anchor positions are juxtaposed, you might also not get the result you expect.

Cheers

[MS MVP - Word]

 

[pit263]

thanks for the help macropod,
when i tried to run the program it told me that something is wrong and marks the
For i = 1 To .Paragraphs.Count
line

Do you know why that is?

 

[PHV]

it told me that something is wrong
Any chance you could post the whole exact error message ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[macropod]

Hi Peter,

What was the error message? Saying that "it told me that something is wrong" isn't very illuminating.

What do you get with:

Sub Test()
Msgbox ActiveDocument.Paragraphs.Count
End Sub

Cheers

[MS MVP - Word]

 

[pit263]

it says "run time error '424'
object required" and offers me to debug
Since i don't know too much about these error messages, i don't know what that means

 

[macropod]

Hi Peter,

I've noticed an error in the code I posted - For some reason the 'h' is missing from the 'End With' statement. See if that fixes it.

Cheers

[MS MVP - Word]

 

[PHV]

The code is for word VBA.
Which application contains your code ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[pit263]

no, i've already noticed that, but that couldn't have been the problem because the line "for i = 1 to .Paragraphs.Count" is marked yellow.
So i figured that VBA can't read it for some unknown reason
Thanks a lot again for your help
Peter

 

[pit263]

it is a VBA code. I am trying to program it in excel, so far without any kind of success

 

[macropod]

Hi Peter,

In your original post, you said you want to "count all the shapes in a [/b]document[/b]" not a workbook. The code I posted is for a Word document ...

Cheers

[MS MVP - Word]

 

[pit263]

hm, sorry about that. My bad.
Is it possible to change the code a bit and then use it for Excel?

 

[macropod]

Hi Peter,

It's not clear to me as to what your criterion is for determining which shape is the last. The following codeworks on the basis that columns take precedence over rows (eg G2 is preferred over E10):

Sub GetLastShape()
Dim oShp As Shape
Dim CellAddr As String
Dim i As Integer
Dim j As Integer
i = 0
j = 0
With ActiveSheet
  For Each oShp In .Shapes
    CellAddr = oShp.BottomRightCell.Address(ReferenceStyle:=xlR1C1)
    If Right(Split(CellAddr, "C")(0), Len(Split(CellAddr, "C")(0)) - 1) >= i Then
      If Split(CellAddr, "C")(1) >= j Then
        i = Right(Split(CellAddr, "C")(0), Len(Split(CellAddr, "C")(0)) - 1)
        j = Split(CellAddr, "C")(1)
      End If
    End If
  Next
MsgBox Cells(i, j).Address
End With
End Sub

You can swap the tests around to change the row/column precedence - you can even delete one of the tests if all you're concerned about is the last row or column.

Note that the returned address is for the "BottomRightCell" at least partially covered by the shape.

My knowledge on Excel vba isn't enough for me to work out the page# on which the returned address appears. That depends on the paper size & orientation, print scaling, the presence of forced page breaks, etc, and can vary from printer to printer. I'll leave that to you or one of the other contributors here to work out.

Cheers

[MS MVP - Word]

 

[Anthony047]

I don't want to compete with macropod, but this might be a simplified version of the macro:

Sub GetLastShape_2()
Dim oShp As Shape
Dim ShLast As Single
Dim ShName As String
'
  For Each oShp In ActiveSheet.Shapes
   If oShp.BottomRightCell.Row > ShLast Then
   ShLast = oShp.BottomRightCell.Row: ShName = oShp.Name
  End If
  Next oShp
MsgBox "Last is " & ShName
ActiveSheet.Shapes(ShName).Select
End Sub

It checks only the row number (bottom-left), and the name of the shape is returned in variable ShName.

Bye,


Anthony047 (GMT+1)

 

[macropod]

Hi Anthony,

I had a mental block when coding. This update to my code should be quicker:

Sub GetLastShape()
Dim oShp As Shape
Dim i As Integer
Dim j As Integer
i = 0
j = 0
With ActiveSheet
  For Each oShp In .Shapes
    CellAddr = oShp.BottomRightCell.Address(ReferenceStyle:=xlR1C1)
    If oShp.BottomRightCell.Row >= i Then
      If oShp.BottomRightCell.Column >= j Then
        i = oShp.BottomRightCell.Row
        j = oShp.BottomRightCell.Column
      End If
    End If
  Next
MsgBox Cells(i, j).Address
End With
End Sub

Cheers

[MS MVP - Word]

 

[Anthony047]

At this point we should be glad to hear from Peter that his problem is now fixed...

Bye.


Anthony047 (GMT+1)

 

[macropod]

Oops, delete the line:
CellAddr = oShp.BottomRightCell.Address(ReferenceStyle:=xlR1C1)

[MS MVP - Word]

 

[pit263]

thanks a lot for the help. I really appreciate it.
the program does work. But as you mentioned, it only looks at the last cell though.
What i would like to have it do, is knowing how many pages to print and then ending in the printpreview mode.
This is something i still can not figure out.

There are two more (i think) little problems that i am dealing with
first, i don't know where to write down sheets(2).Select or Activate since i would like to get the printpreview for the sheet(2) not sheet(1)
second, when i run the program, it will tell me the cell that the last shape is in, but when i go on printpreview it obviously doesn't take that in consideration.
My backround is all blue which leads excel to want to print 20 pages. Of course not what i have in mind.

Thands so much again for the help

Peter

 

[Anthony047]

I think you could use the following macro, that first identify the "last" shape, then determine on which page that shape lays on.

Sub GetLastShape_2()
Dim oShp As Shape
Dim ShLast As Single
Dim ShName As String
'
  For Each oShp In ActiveSheet.Shapes
   If oShp.BottomRightCell.Row > ShLast Then
   ShLast = oShp.BottomRightCell.Row: ShName = oShp.Name
  End If
  Next oShp
' MsgBox "Last is " & ShName          'needed?
'ActiveSheet.Shapes(ShName).Select    'no longer needed
'
'Identify the page num.
Range("A1").Select
ActiveWindow.View = xlPageBreakPreview
 For Each PB In ActiveSheet.HPageBreaks
 PB.Location.Select
 NextPRow = ActiveCell.Row
 PCount = PCount + 1
If NextPRow >= ShLast Then Exit For
Next PB
ActiveWindow.View = xlNormalView
'
'print pages
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=PCount, Copies:=1, Collate:=True
End Sub

You might need to complete the printing section, for example to select a printer different than "the current one"; you can do this by recording a macro and than pick up the useful instrucions and set them into the above macro.

Bye.


Anthony047 (GMT+1)

 

[macropod]

Hi Anthony,

I like the approach, but there's a couple of problems yet to be ironed out. One needs to use both the column and row addresses to determine the last page to print; otherwise too many pages may be printed because of the way the worksheet shading is affecting Excel's interpretation of the print area.

If I understand Peter's situation correctly, the only way the shape's address can determine the print area is if you run two loops (one each for row & column) rightwards & downwards from the shape's BottomRightCell address, resetting the print area one cell at a time until both the HPageBreaks count and the VPageBreaks count increase by 1. The cell diagonally up to the left of that is the BottomRightCell that's used to set the print area.

Cheers

[MS MVP - Word]