ボブは、ドキュメント内のすべてのグラフィックを数える必要があります。一部のグラフィックはインラインで、一部はフローティングです。写真として挿入されたものもあれば、Wordの描画ツールを使用して作成されたものもあります。ボブは、ドキュメントに150〜200のグラフィックがあると考えていますが、すばやくカウントする方法が欲しいと考えています。

グラフィック数を取得するために試すことができることがいくつかあります。まず、単純な検索と置換を使用します。 ^ gを検索し、^&に置き換えるだけです。これにより、グラフィックが検索され、見つかったものに置き換えられます。つまり、ドキュメントに変更はありません。ただし、Wordは、実行されると、「置換」がいくつ行われたかを通知します。この数は、ドキュメント内のグラフィックの数です。

このアプローチの問題は、ドキュメント内のインライン画像のみをカウントすることです。描画レイヤー上のものを「検索して置換」することはありません。すべての画像を取得するには、別のアプローチを試す必要があります。たとえば、Wordの[移動]機能を使用できます。 F5キーを押して、[検索と置換]ダイアログボックスの[移動]タブを表示します。画面の右側で[グラフィック]を選択した場合は、[次へ]ボタンをクリックして、ドキュメント内のグラフィックをステップスルーできます。グラフィックがたくさんある場合は、ボックスに+150のようなものを入れて、[移動]をクリックするだけです。利用可能な場合は、そのグラフィック番号にジャンプし、残りの番号を順番に数えていくことができます。

このアプローチは、検索と置換のアプローチよりもグラフィックの検索に優れています。ただし、ドキュメント内にグラフィックを配置できる場所があり、GoToではキャッチされないため完全ではありません。

(または、正直なところ、Go Toと同じ検索メカニズムを使用するオブジェクトブラウザーによって。)このアプローチは、インラインで描画レイヤー上にあるグラフィックを検索します。ただし、ヘッダーやフッターなどの他の場所では見つかりません。それらを見つけてカウントに含めるには、マクロを使用する必要があります。以下は、より包括的なグラフィック数を提供するマクロです。

Sub CountGraphics()

Const sBkMk = "ReturnHere"



Dim lngSections As Long     Dim lngSectionCounter As Long     Dim lngMainDocInlineShapes As Long     Dim lngMainDocShapes As Long     Dim lngHdrInlineShapes As Long     Dim lngHdrShapeRange As Long     Dim lngFtrInlineShapes As Long     Dim lngFtrShapeRange As Long     Dim lngTotalInlineShapes As Long     Dim lngTotalShapes As Long     Dim sMsgText As String

Application.ScreenUpdating = False

'Get the number of sections in the document.

lngSections = ActiveDocument.Sections.Count

'Get the number of inline objects and     'shape objects in the main document     lngMainDocInlineShapes = ActiveDocument.InlineShapes.Count     lngMainDocShapes = ActiveDocument.Shapes.Count

'Insert a bookmark to return to this place in the document.

ActiveDocument.Bookmarks.Add sBkMk, Selection.Range

'Go to the first page of the document.

Selection.HomeKey wdStory, wdMove

'Cycle through all of the sections in the document     'looking in headers and footers for graphics     For lngSectionCounter = 1 To lngSections         'Go to the header of the current page         ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader         Selection.WholeStory         'Get the number of inline objects and shape objects         lngHdrInlineShapes = lngHdrInlineShapes _           + Selection.Range.InlineShapes.Count         lngHdrShapeRange = lngHdrShapeRange _           + Selection.Range.ShapeRange.Count

'Go to the footer of the current page         ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageFooter         Selection.WholeStory         'Get the number of inline objects and shape objects         lngFtrInlineShapes = lngFtrInlineShapes _           + Selection.Range.InlineShapes.Count         lngFtrShapeRange = lngFtrShapeRange _           + Selection.Range.ShapeRange.Count

Selection.GoTo wdGoToSection, wdGoToNext     Next

'Go to the main body of the document.

ActiveDocument.ActiveWindow.View.SeekView = wdSeekMainDocument

'Enable automatic screen updates     Application.ScreenUpdating = True     Application.ScreenRefresh

'Go to the bookmark that was inserted earlier.

If ActiveDocument.Bookmarks.Exists(sBkMk) Then         Selection.GoTo wdGoToBookmark, , , sBkMk         ActiveDocument.Bookmarks(sBkMk).Delete     Else         MsgBox "The bookmark '" & sBkMk & "' does not exist."

End If

'Calculate the total number of inlineshape objects     'and (shape and shaperange) objects     lngTotalInlineShapes = lngMainDocInlineShapes _       + lngHdrInlineShapes + lngFtrInlineShapes     lngTotalShapes = lngMainDocShapes _       + lngHdrShapeRange + lngFtrShapeRange

'Include the values from the variables into the     'text of the message     sMsgText = vbTab & vbTab & "Inline Shapes" _       & vbTab & "Other Shapes" & vbCr _       & "Main Document:" & vbTab & lngMainDocInlineShapes _       & vbTab & vbTab & lngMainDocShapes & vbCr _       & "Headers:" & vbTab & vbTab & lngHdrInlineShapes _       & vbTab & vbTab & lngHdrShapeRange & vbCr _       & "Footers:" & vbTab & vbTab & lngFtrInlineShapes _       & vbTab & vbTab & lngFtrShapeRange & vbCr _       & "Total:" & vbTab & vbTab & lngTotalInlineShapes _       & vbTab & vbTab & lngTotalShapes & vbCr & vbCr _       & "Note: The values for the headers and the footers " _       & "could include duplicates."



'Display the results of the procedure.

MsgBox sMsgText End Sub

マクロは、メインドキュメント内のグラフィックの数だけでなく、ドキュメント内の各セクションをステップスルーし、グラフィックのヘッダーとフッターを調べることに注意してください。このマクロで覚えておくべきことがいくつかあり、返されるカウントの精度に影響を与える可能性があります。これらの項目はすべて、Wordがドキュメント内のグラフィックを処理する方法の一部です。

  • ドキュメントに描画キャンバスが含まれている場合、含まれている個々の図形の数に関係なく、単一のグラフィック(図形オブジェクト)として扱われます。

  • 個別の形状は個別にカウントされます。別々の形状がグループ化されると、それらは単一の形状としてカウントされます。

最後に、グラフィックの数を取得する方法がもう1つあります。それは、ドキュメントをWebページ(HTML形式)として保存するだけです。この方法で保存するプロセスの一部として、Wordはドキュメント内のグラフィックファイルを独自のフォルダに保存します。次に行う必要があるのは、フォルダー内のファイルの数を確認することだけです。これにより、ドキュメント内のグラフィックの数がわかります。 (ドキュメントをHTML形式で保存する方法は、他の_WordTips_で説明されています。)

注:

このページ(または_WordTips_サイトの他のページ)で説明されているマクロの使用方法を知りたい場合は、役立つ情報を含む特別なページを用意しました。

_WordTips_は、費用効果の高いMicrosoftWordトレーニングのソースです。

(Microsoft Wordは、世界で最も人気のあるワードプロセッシングソフトウェアです。)このヒント(10388)は、Microsoft Word 2007、2010、2013、および2016に適用されます。Wordの古いメニューインターフェイス用のこのヒントのバージョンは、次の場所にあります。 linkCounting AllGraphics