VBA 宏计算 MS Word 文档中所有图形占用的区域

Question

(I apologise for my English.) I am preparing textbook for students and I would need to calculate area occupied by all figures in MS Word document. Simple example with just two figures:

Figure 1: 12 cm x 10 cm = 120 cm2 Figure 2: 8 cm x 10 cm = 80 cm2 TOTAL: 200 cm2

The total number is enough , it is not necessary to know size of each figure (but can be helpful, if not too complicated). Many, many years ago I wrote such macro in WordPerfect 6 for DOS — it was quite easy. But my knowledge of VBA is very, very limited. I tried really hard to look at VBA help, but I have no clue what to look for. I also tried Google etc. (and of course StackOverlow) without finding any hint.

I need that because in our country, the total size (length) of manuscript of the textbook is calculated as AA total = AA text + AA figures , where AA text = Chars in doc/36,000 and AA figures = area/2,300 . AA text can be easily calculated from File, Information, but no easy way for calculation of AA figures.

Also, my MS Word is not in English (not sure if such VBA macro works without any problems in different language version of MS Word). Any help welcome.

Thank you very much in advance.

Jiri

Answer by macropod is quite clear for me, but I still have problem with the macro. (1) Probably because I do not have any inline figures in my document, the macro ends with error on the following line (the second one). The error message is No. 91 " Object variable or With block variable not set ". First, I was confused, and came to wrong conclusion: There is missing explicit assignment of zero to Sizes variable somewhere at the beginning of the macro. And modified macro such way.

Sizes = Sizes + PointsToCentimeters(.Height) * PointsToCentimeters(.Width)  

(2) Later I used only the first half of the macro: the first loop ( For Each Shp In.Shapes ). Now the macro runs without any errors but looks like the macro cannot see any figures and the final message is: The document contains 0 Floatings shapes, whose area totals 0,00cm . All my figures were inserted as: Insert > Pictures > This Device .

I have prepared minimalist Word.docm document (just one page, two figures and macro) for better replication of the problem. But even on Help center of Stackoverflow I cannot find if it possible/acceptable to add such file to question. I welcome any suggestion what the problem with the macro is.

Answer 1

It all depends on what you mean by 'figures'. For example, the following macro gets the combined sizes of all 'images' in the document body:

Sub Demo()
Dim Shp As Shape, iShp As InlineShape, Sizes As Single, i As Long
With ActiveDocument
  For Each Shp In .Shapes
    With Shp
      i = i + 1
      Sizes = Sizes + PointsToCentimeters(.Height) * PointsToCentimeters(.Width)
    End With
  Next
  For Each iShp In .InlineShapes
    With Shp
      i = i + 1
      Sizes = Sizes + PointsToCentimeters(.Height) * PointsToCentimeters(.Width)
    End With
  Next
End With
MsgBox "The document contains " & i & " Floating & Inline Shapes, whose area totals " & Format(Sizes, "0.00") & "cm" & Chr(178)
End Sub