ワードVBAのことですが、文書の中に図形のボックスが何個か並んでいます(2列で)。それぞれのボックスの中に、同じ画像をボタン1発で挿入するということを簡単なVBAで実現できるものでしょうか。

#同じ画像を全部のボックスに挿入したい。

#ワードのVBAの経験なしです。
#できるとしたら何行くらいの記述でできるものかという難易度も知りたい。
#とても簡単なサンプルコードも教えていただけると尚ありがたいです。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

s-holmesさんこんにちは。


私も、Wordのvbaは扱うことがないのですが、今回挑戦してみました。
まず、ドキュメント上に、”コントロールツールボックス”のメニューボタンからコマンドボタンを選択して貼り付けます。デフォルトの名前が"CommandButton1"になると思いますが、このボタンを右クリックして、立ち上がるVBEのイベントプロシージャに以下のようなコードを記述しました。

Private Sub CommandButton1_Click()
Dim myf As String
myf = "ここに画像ファイルまでのパスとファイル名を入れる"
With ActiveDocument
For i = 1 To .Shapes.Count
.Shapes(i).Fill.UserPicture myf
Next i
End With
End Sub

一応、Word2000にて動作確認しています。
    • good
    • 0
この回答へのお礼

おおお!出来ました。ちょっと感動だ。
スクリプトの意味はなんとなくわかるという程度ですが、これを機会に少しは勉強してみたいです。ありがとうございました。

お礼日時:2001/04/19 06:16

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qワードで画像を自動で挿入する方法

ワード2000を使用しています。フォルダにgif画像が200個程入っており(ファイル名は毎回変わります)、これをワードに1つずつ画像を挿入する作業をしているのですが、自動で処理するようなフリーソフトや方法があれば教えて下さい。出来れば挿入したファイル名も表示されるとうれしいのですが・・
宜しくお願い致します。

Aベストアンサー

ちょうど、マクロを作っていましたので紹介します。

Sub 画像取込()
myFolda = "C:\My Documents\My Pictures" '-gifファイルのフォルダ
Set fs = Application.FileSearch
DoEvents
With fs
 .NewSearch
 .LookIn = myFolda
 .SearchSubFolders = False
 .FileName = "*.gif"
 If .Execute() > 0 Then
  For I = 1 To .FoundFiles.Count
   myfname = .FoundFiles(I)
   Selection.TypeParagraph
   Selection.InlineShapes.AddPicture FileName:= _
   myfname, LinkToFile _
    :=False, SaveWithDocument:=True
   Selection.TypeParagraph
   Selection.TypeText Text:= _
   Right(.FoundFiles(I), _
    Len(.FoundFiles(I)) - Len(myFolda) - 1)
   Selection.TypeParagraph
  Next I
 End If
End With
MsgBox "貼り付け完了"
End Sub

上記"Sub 画像取込()"から"End Sub"までがマクロになります。この例ではC:\My Documents\My Picturesのフォルダにあるgifファイルすべてが対象です。適宜フォルダへのパスを変更してください。
マクロの実行方法ですが、
1, 画像ファイルを貼り付けるword文書を開いて、Alt+F11キーを押します。
2, VisualBasicEditorが立ち上がりますので、左の方のプロジェクトエクスプローラのTisDocumentが選択されているのを確認して、コードウインドウに上記マクロをコピー&ペーストしてください。
3, VisualBasicEditorを閉じて、Alt+F8キーを押すとマクロリストのダイアログが立ち上がりますので、"画像取込"を選択して"実行"をクリックします。

マクロはコマンドボタンに登録することもできます。

windows2000 word2000 で動作確認

ちょうど、マクロを作っていましたので紹介します。

Sub 画像取込()
myFolda = "C:\My Documents\My Pictures" '-gifファイルのフォルダ
Set fs = Application.FileSearch
DoEvents
With fs
 .NewSearch
 .LookIn = myFolda
 .SearchSubFolders = False
 .FileName = "*.gif"
 If .Execute() > 0 Then
  For I = 1 To .FoundFiles.Count
   myfname = .FoundFiles(I)
   Selection.TypeParagraph
   Selection.InlineShapes.AddPicture FileName:= _
   myfname, LinkToFile ...続きを読む

QWord VBA 写真 挿入

Excel で写真の挿入VBAは 皆さんのご回答を元になんとか出来ました。
回答者さま 有難う御座いました。
挿入したファイル(写真)のサイズ変更(見た目のサイズ)も出来ます。


ところが、
Wordへの写真挿入 
サイズの変更 になりますと、(VBAで記述したいのに)

「図の書式設定」自体効きません。

↑ 「マクロの記録」をしても、出来ません。
(ボタンは False 状態)


「マクロの記録」で出来ないという事は
つまり、Wordでは無理って考えれば良いのでしょうか。

Aベストアンサー

こんにちは。KenKen_SP です。

> つまり、Wordでは無理って考えれば良いのでしょうか。

何をやりたいのか具体的に書かれてないので、コメントし難いのですが、
とりあえず、画像を挿入したいなら、

  Application.Dialogs(wdDialogInsertPicture).Show

で画像挿入のダイアログを表示できます。また、ファイル名を指定して画像を
挿入し、各種操作するには、

Sub Sample()

  Dim PIC As Shape
  Dim strFilename As String

  strFilename = "C:\Sample.jpg"

  Set PIC = ActiveDocument.Shapes.AddPicture(strFilename)
  With PIC
    .LockAspectRatio = msoTrue ' 縦横比を保つ
    ' ミリメートル指定でサイズを変更する場合(例:50mm)
    .Width = MillimetersToPoints(50)
    ' 水平方向の位置を決めるときの基準点を余白に設定
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
    ' 垂直方向の位置を決めるときの基準点を余白に設定
    .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    ' ミリメートル指定で余白位置からの場所を指定(例:上10mm、左10mm)
    .Top = MillimetersToPoints(10)
    .Left = MillimetersToPoints(10)
    ' さらに動かしてみる(例:20ポイントずらす)
    ' ミリメートル指定なら .IncrementTop MillimetersToPoints(10) で 10mm
    .IncrementTop 20
    .IncrementLeft 20
    ' さらに回転(例:90度)
    .IncrementRotation 90#
  End With
  Set PIC = Nothing

End Sub

こんな感じで。微妙に Excel とは違いますが、基本は一緒です。

こんにちは。KenKen_SP です。

> つまり、Wordでは無理って考えれば良いのでしょうか。

何をやりたいのか具体的に書かれてないので、コメントし難いのですが、
とりあえず、画像を挿入したいなら、

  Application.Dialogs(wdDialogInsertPicture).Show

で画像挿入のダイアログを表示できます。また、ファイル名を指定して画像を
挿入し、各種操作するには、

Sub Sample()

  Dim PIC As Shape
  Dim strFilename As String

  strFilename = "C:\Sample.jpg"

  Set PIC = Acti...続きを読む

Qワードマクロで画像を選択する方法

「図の挿入」を使って画像ファイルから読み込んで貼り付けた画像を、ワードマクロで選択したいと思っています。
どのようなコードを書けばいいか、教えてください。

ちなみに、以前どなたかがされた質問に対する回答(http://oshiete1.goo.ne.jp/qa2224793.html)で
ActiveDocument.Content.ShapeRange.Select
を使うという方法が提示されていましたが、「図の挿入」で読み込んだ画像ファイルには使えないようです。

よろしくお願いします。

Aベストアンサー

#1のご回答がありますが
私も判らずながらやってみました。
http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/vbawd11/html/woobjInlineShapes1.asp
にInlineShapes の説明があります。
ーー
まずエクセルの操作で、挿入ー図ーファイルからでファイル名を指定します。
するとInlineShapes のオブジェクトになるようで、
Sub test02()
For Each ishape In ActiveDocument.InlineShapes
ishape.ConvertToShape
Next ishape

End Sub
を実行するとShape オブジェクトに変換できます。
Sub test01()
Dim pc As Object
Dim ishape As Object
MsgBox ActiveDocument.Shapes.Count
MsgBox ActiveDocument.InlineShapes.Count
For Each pc In ActiveDocument.Shapes
MsgBox pc.Name
Next
End Sub
を実行しますと
メッセージボックスで2と0がでて
Picture 6
などと表示できます。
Sub test03()
ActiveDocument.Shapes("Picture 6").Select
Selection.Delete
End Sub
で削除できました。
ーーー
InlineShapeを捉える件ですが
http://www.keep-on.com/excelyou/2001lng4/200112/01120012.txt
に書いておられますが
Indexでしか捕らえられないのかもしれません。
Sub test04()
MsgBox ActiveDocument.InlineShapes.Count
n = ActiveDocument.InlineShapes.Count
For i = 1 To n
MsgBox ActiveDocument.InlineShapes(i).Height
Next i
End Sub
私もNameでやってみましたができませんでした。
他に方法があるのかどうかわかりません。
Shapes->InlineShapeは選択したものにつき
Sub ConvertToInlineShape()
With Selection
' \\ If we selected a Shape then convert to InlineShape
If .Type = wdSelectionShape Then
.ShapeRange(1).ConvertToInlineShape
End If
End With
End Sub
というコードを見つけました。
Pictureの判別は
Sub test05()
Dim inlineShape
For Each inlineShape In ActiveDocument.InlineShapes
If inlineShape.Type = wdInlineShapePicture Then
MsgBox inlineShape.Height
End If
Next
End Sub
を見つけました。

#1のご回答がありますが
私も判らずながらやってみました。
http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/vbawd11/html/woobjInlineShapes1.asp
にInlineShapes の説明があります。
ーー
まずエクセルの操作で、挿入ー図ーファイルからでファイル名を指定します。
するとInlineShapes のオブジェクトになるようで、
Sub test02()
For Each ishape In ActiveDocument.InlineShapes
ishape.ConvertToShape
Next ishape

End Sub
を実行するとShape オブジェクトに変換で...続きを読む

QVBSでワードに画像を貼り付ける

VBSを使用して、
2ページあるワードテンプレートの2ページ目に、
画像を貼り付けたいのですが、方法がわかりません。
方法がありましたら、教えていただけますと助かります。

ちなみに、下記のようなhoge.vbsを書いて試行錯誤していますが、
この場合、1ページ目に画像が張り付いてしまいます…

---
Dim word
Dim doc
Set word = CreateObject("Word.Application")
word.visible=true
word.Activate
word.WindowState=wdWindowStateNormal
word.Documents.Open "C:\***\***.dot"
word.Selection.MoveDown 5, 17    
//⇒17行後に2ページ目へ移行するデータです。
word.ActiveDocument.Shapes.AddPicture "C:\***\***.bmp"
word.Selection.EndKey
word.ActiveWindow.SetFocus
---

VBSを使用して、
2ページあるワードテンプレートの2ページ目に、
画像を貼り付けたいのですが、方法がわかりません。
方法がありましたら、教えていただけますと助かります。

ちなみに、下記のようなhoge.vbsを書いて試行錯誤していますが、
この場合、1ページ目に画像が張り付いてしまいます…

---
Dim word
Dim doc
Set word = CreateObject("Word.Application")
word.visible=true
word.Activate
word.WindowState=wdWindowStateNormal
word.Documents.Open "C:\***\***.dot"
word.Select...続きを読む

Aベストアンサー

マクロを記録して調べたところ、下記でいけるのではないでしょうか。

【変更前】word.ActiveDocument.Shapes.AddPicture "C:\***\***.bmp"
【変更後】word.Selection.InlineShapes.AddPicture "C:\***\***.bmp"

Windows XP SP2 + Word 2002で試しました。

Q【ワード】マクロで画像を選択する

ワードでマクロを記録している途中は、画像を選択できないのですが、
画像を選択という処理はマクロに出来ないのでしょうか?

Aベストアンサー

こんな感じ。

  ActiveDocument.Content.ShapeRange("Picture 1").Select

ShapeRange はシェープ等も含んでしまいますが、一括選択するなら、

  ActiveDocument.Content.ShapeRange.Select

です。ShapeRange を ヘルプで調べてみて下さい。名前を列挙するなら、

  For Each Pic In ActiveDocument.Content.ShapeRange
    If Pic.Name Like "Picture*" Then '<--画像だけ
      MsgBox Pic.Name
    End If
  Next Pic

のように ActiveDocument.Content (アクティブな文書の本文内)にある
ShapeRange コレクション(シェープや画像の集まり)を For Each ループ
で回します。

QWordVBAで規定のところに文字列を挿入したい

 VBA超初心者の質問です。
 ExcelVBAでは値をセルに代入することは出来ますが、WordVBAで規定の場所に文字列を代入するといったことはどうすれば良いのでしょうか?
 できれば、テキストボックスの中身と連動できたらと思うのですが、できますか?
 ちなみに、私はVBAはほとんど知識がありません。
 ただ単にVBAの勉強の手始めにこれだけ教えてください。
 Web検索しても見つからないので、よろしくお願いします。

Aベストアンサー

私もワードのVBAは初心者です。
(テキストボックスの作り方・値のセットのし方)
値は手動でなく、プログラムでセットする方法です。
Sub test05()
ActiveDocument.Shapes.AddTextbox _(msoTextOrientationHorizontal,100 ,100,100,100).Select
Selection.TypeText Text:="東京都文京区"
End Sub
100,・・のところは、Left,Top,Width,Heightの指定です。ワードに貼り付けるコントロールはShapesでまとめられていて、エクセルなどと違うようです。
(所定のところへテキストボックスの値をセットのし方)
「所定のところ」と言うのが、ワードの場合は曲者なような気がする。取りあえず何行目の何文字目と言う指定を知りましたので、記します。
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
MsgBox TextBox1.Text
Selection.MoveDown unit:=wdLine, Count:=3
Selection.MoveRight unit:=wdCharacter, Count:=8
Selection.TypeText Text:=TextBox1.Text
End Sub
テキストボックスのイベントを、どれで捕らえるかが難しいが、比較的人為的にしないと起こらないダブルクリックにしました。
テキストボックス内に文字を入れ、テキストボックス内で
ダブルクリックすると3行下の該当文字から8文字目に
入力文字が挿入されます。
ワードのVBAは(1)解説書が少ない。(2)エクセルのように、Cell(Range)に当たる基本的な単位に当たるものが、見つからない。(3)エクセル・アクセスVBAと統一されていない(4)ビジネスなどで利用応用出来る場面が良く見えない。など学習は苦難の道が待っている気がします。OKWEBの質問も回答も少ないようです。お互いに頑張りましょう。

私もワードのVBAは初心者です。
(テキストボックスの作り方・値のセットのし方)
値は手動でなく、プログラムでセットする方法です。
Sub test05()
ActiveDocument.Shapes.AddTextbox _(msoTextOrientationHorizontal,100 ,100,100,100).Select
Selection.TypeText Text:="東京都文京区"
End Sub
100,・・のところは、Left,Top,Width,Heightの指定です。ワードに貼り付けるコントロールはShapesでまとめられていて、エクセルなどと違うようです。
(所定のところへテキストボックスの値をセットのし方...続きを読む

QExcelのVBAで画像読込→サイズ変更がしたい。

Excel2003を利用して仕事の工事写真帳を作成していますがVBAでどうしても上手くいかない部分があるので教えていただければと思い投稿しました。
【仕様】工事写真帳は1シート構成、用紙1枚に3枚画像が入り、画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ(写真サイズに結合してあります)を取得して画像サイズを変更して格納します。
【問題点】2枚以上画像を読み込んだ状態で実行すると目的の画像のサイズが変更にならない場合があります。
画像を削除したことで画像の名前が重複するのが原因だというところまではわかるのですが対処方法がわかりません。アドバイスをお願いします。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

gyo = ActiveCell.Row '画像読込位置の取得
Set scel = Cells(gyo, 3)

scel.Select 'セルサイズの取得
w = Selection.Width
h = Selection.Height

fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像ファイルを指定して下さい") '画像読込
If fname = False Then
Exit Sub
End If
ActiveSheet.Pictures.Insert(fname).Select
i% = Selection.Index


Selection.Name = "gazou" & i '画像に名前をつける
Set 画像 = ActiveSheet.Shapes("gazou" & i)


With 画像 '画像のサイズ変更
.LockAspectRatio = False
.Placement = xlFreeFloating
.Placement = xlMove
.Width = w
.Height = h
End With

Range("F" & gyo).Select '摘要欄へ移動

End Sub

Excel2003を利用して仕事の工事写真帳を作成していますがVBAでどうしても上手くいかない部分があるので教えていただければと思い投稿しました。
【仕様】工事写真帳は1シート構成、用紙1枚に3枚画像が入り、画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ(写真サイズに結合してあります)を取得して画像サイズを変更して格納します。
【問題点】2枚以上画像を読み込んだ状態で実行すると目的の画像のサイズが変更にならない場合があります。
画像を削除したことで画...続きを読む

Aベストアンサー

画像にわざわざ名前をつける必要はあるのでしょうか?
(以下は一部抜粋して、少しだけ手を入れました)

Dim pict As String
 ActiveSheet.Pictures.Insert(fname).Select
 pict = Selection.Name
 With ActiveSheet.Shapes(pict) '画像のサイズ変更
  .LockAspectRatio = False
  .Placement = xlFreeFloating
  .Placement = xlMove
  .Width = w
  .Height = h
 End With

これなら画像を繰り返し削除しても大丈夫に思います

Q任意フォルダから画像をすべてエクセルの指定マスに貼り付けをしたい

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるようにしようとすると、かなり難易度が高くお手上げ状態です。
このプログラムをどのように改修すれば可能になるかお教えください。

Sub 図11()

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)

' 貼り付け開始セルを選択
Range("B6").Select

' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の高さをアクティブセルにあわせる
' 結合セルの場合でも対応
.Height = ActiveCell.MergeArea.Height
End With

' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
ActiveCell.Offset(5).Select

Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True

End Sub

よろしくおねがいします。
※マクロはほぼ初心者です。大体がネットからコピペをして使っている程度のレベルです。

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるよう...続きを読む

Aベストアンサー

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトしてください。また、DoEvents も入れておきました。
④は、何も手を付けていません。
コメント・アウトした部分で不要なら削除してください。

'//
Sub 図11R()
 'No. 9024507
 Dim strFilter As String
 Dim Filenames() As Variant
 Dim fName As Variant, ext As String
 Dim PIC As Picture
 Dim k As Long, m As Long
 Dim i As Long, j As Long
 Dim cnt As Long
 Dim FirstRng As Range
 Dim r As Range
 Dim Sel_Folder As Object, Sel_Path As String
 cnt = 0 'カウントの初期値
 '貼り付け最初のセル
 Set FirstRng = Range("A2")
 
  Set Sel_Folder = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "フォルダを選択してください", 5)

  If Not Sel_Folder Is Nothing Then
    Sel_Path = Sel_Folder.Self.Path
  Else
   Exit Sub
  End If
 
 ' 「ファイルを開く」ダイアログでファイル名を取得
 ChDir Sel_Path
' strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
' Filenames = Application.GetOpenFilename( _
' FileFilter:=strFilter, _
' Title:="図の挿入(複数選択可)", _
' MultiSelect:=True)
 fName = Dir("*.*", vbNormal)
 Do While fName <> ""
  If fName <> "." And fName <> ".." Then
   ext = Mid(fName, InStrRev(fName, ".") + 1)
   If InStr(1, "jpg,jpeg,gif,bmp,png", ext, 1) > 0 And Not fName Like "#*" Then
    cnt = cnt + 1
    DoEvents
    ReDim Preserve Filenames(1 To cnt)
    Filenames(cnt) = fName
    ''安全のため(上限を設定)
    If cnt > 100 Then Exit Do
   End If
  End If
  fName = Dir()
 Loop
 If cnt = 0 Then Exit Sub
 
 ' ファイル名をソート
 Call BubbleSort_Str(Filenames, True, vbTextCompare)
 
 '' 貼り付け開始セルを選択
 'Range("B6").Select
 
 ' マクロ実行中の画面描写を停止
 Application.ScreenUpdating = False
 ' 順番に画像を挿入
 k = LBound(Filenames)
 m = UBound(Filenames)
 
 For j = 1 To Int(m / 4) + Abs(m Mod 4 > 0)
  For i = 1 To 4
   Set PIC = ActiveSheet.Pictures.Insert(Filenames(k))
   Set r = FirstRng.Cells(1 + (j - 1) * 2, i)
   
   '-------------------------------------------------------------
   ' 画像の各種プロパティ変更
   '-------------------------------------------------------------
   With PIC
    .Top = r.Top ' 位置:アクティブセルの上側に重ねる
    .Left = r.Left ' 位置:アクティブセルの左側に重ねる
    .Placement = xlMove ' 移動するがサイズ変更しない
    .PrintObject = True ' 印刷する
   End With
   With PIC.ShapeRange
    .LockAspectRatio = msoTrue ' 縦横比維持
    ' 画像の高さをアクティブセルにあわせる
    ' 結合セルの場合でも対応
    .Height = r.MergeArea.Height
   End With
   
   ' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
   ' ActiveCell.Offset(5).Select
   
   Set PIC = Nothing
   k = k + 1
   If k >= m Then Exit For
  Next i
 Next j
 Application.ScreenUpdating = True
 ChDir ThisWorkbook.Path
End Sub

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトし...続きを読む

QWord VBA 表内の図を一括中央揃えにするマク

Wordの表に3,000個ほどの図を入れ、それぞれコメントを入れておりますが、図の位置が左揃えになったり、中央揃えになったり、右揃えになったりしています。これら図だけを一括して中央揃えにするマクロを作ろうとしています。 図のサイズを一括して変更するマクロは資料を参考にして出来ましたが、中央揃えにするマクロがどうしても出来ません。 参考にして作ったプログラムは以下の通りですが、コンパイルエラーになってしまいます。 四苦八苦しています。どなたかご指導お願いします。

Sub 図の一括中央揃え()
'
' 図の一括中央揃え
'
'

Dim shp As InlineShape

For Each shp In ActiveDocument.InlineShapes
shp.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next

End Sub

Aベストアンサー

InlineShapeのメンバーにParagraphFormatがないためです。
http://msdn.microsoft.com/ja-jp/library/office/ff840794(v=office.15).aspx

この場合、Rangeを追加してParagraphFormatを使えるようにします。

Sub 図の一括中央揃え()
'
' 図の一括中央揃え修正版
'
Dim shp As InlineShape

 For Each shp In ActiveDocument.InlineShapes
 shp.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
 Next

End Sub

QWORD VBAのShapesのこと

昨日TTakさんから下記のマクロを御教授いただいて助かっているのですが、特定のShapesを除外して下記を実行する方法があれば教えていただけないでしょうか。

Private Sub CommandButton1_Click()
Dim myf As String
myf = "ここに画像ファイルまでのパスとファイル名を入れる"
With ActiveDocument
For i = 1 To .Shapes.Count
.Shapes(i).Fill.UserPicture myf
Next i
End With
End Sub

Aベストアンサー

s-holmesさん、またまたこんにちは。
前回提示したコードは、任意の図形の因数 "Index" を変数にして、ドキュメント内のすべての図形に画像を入れるというものです。したがって、特定の図形だけはずすという場合は、(もうお解りですね)IF 文で、特定の Index 番号の時だけ "Shapes(i).Fill.UserPicture myf" を実行しないようにします。
しかし、一つ問題あります。それは、特定の図形の Index が何番なのかを探す方法です。
基本的には図形を書いた順番に割り振られていると思うのですが、当該図形をアクティブにした後、イミデイトウインドウに"?Selection.Index"と入れて[Enter]すると、Index値を返してくれます。しかし、この方法はEXCEL-VBAでは可能ですが、WORD-VBAではできません。苦肉の策として、"Name"が一致するか否かで一々判断させることにしました。
#この部分はもっといい方法があるかもしれません。

1, VBエディタを起動し、イミデイトウインドウも表示しておきます。
2, Wordドキュメントに戻って、画像を入れたくない図形を選択してアクティブにします。
3, 再度VBエディタに戻って、イミデイトウインドウに"?ActiveDocument.Shapes(1).Name=selection.ShapeRange.Name"と記入し、[Enter]します。
4, 下の段に"TRUE"と出るまで、Shapes(1),Shapes(2),Shapes(3)....とindex値を変化させます。
5, "TRUE"が出ると、選択された図形のindexが判りますので、下記のようにコードを分岐します。

Private Sub CommandButton1_Click()
Dim myf As String, i As Integer, x1 As Integer
myf = "ここに画像ファイルまでのパスとファイル名を入れる"
x1 = 画像を入れたくない図形のindex値
With ActiveDocument
For i = 1 To .Shapes.Count
If i = x1 Then Exit For Else .Shapes(i).Fill.UserPicture myf
Next i
End With
End Sub

index値を追加する場合はx2,x3,.....として、If文の条件分岐を追加してください。
Word2000にて動作確認済みです。

s-holmesさん、またまたこんにちは。
前回提示したコードは、任意の図形の因数 "Index" を変数にして、ドキュメント内のすべての図形に画像を入れるというものです。したがって、特定の図形だけはずすという場合は、(もうお解りですね)IF 文で、特定の Index 番号の時だけ "Shapes(i).Fill.UserPicture myf" を実行しないようにします。
しかし、一つ問題あります。それは、特定の図形の Index が何番なのかを探す方法です。
基本的には図形を書いた順番に割り振られていると思うのですが、当該図形をアクテ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング