• 締切済み

ワードでマクロで画像を中央揃えにしたい

 ワードでマクロを使って、挿入・画像ファイルで取り込んだ画像を、レイアウトの詳細設定で水平、垂直ともページを基準にして、中央揃えにしたいのです。  画像は1ページに1枚です。  たくさんの画像を一つ一つやるのは大変です。  やり方のわかる方がいたらお願いします。  参考までに画像を取り込む部分を載せておきます。 ' Sub Macro1() ' Dim FileName As String ' ChDir ThisDocument.Path ' FileName = Dir("*.jpg") While FileName > "" Selection.InsertBreak Type:=wdPageBreak ' 改ページ Application.Browser.Previous ' 前のページへ ' 画像の読み取り ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, _ FileName:=FileName, LinkToFile:=False, _ SaveWithDocument:=True).WrapFormat.Type = 5 ' Application.Browser.Next ' 次のページへ ' FileName = Dir Wend ' End Sub '

みんなの回答

  • skp026
  • ベストアンサー率45% (1011/2238)
回答No.1

お試し済みでしたらごめんなさい。 書式の置き換え機能は利用できるかもしれないです。 たしか図にもできたはず… すみません。間違えてたらごめんなさい。

SI299792
質問者

お礼

回答ありがとうございます。しかし、書式の置き換えの使い方がわかりません。画像を指定する方法をご存知でしたら教えて下さい。お願いします。

SI299792
質問者

補足

回答ありがとうございます。しかし、書式の置き換えの使い方がわかりません。ネットで調べたけれど、文字の場合しか出てきませんでした。画像を指定する方法をご存知でしたら教えて下さい。お願いします。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • Shape画像保存モードの事後変更

    VBA Excel2007を使用しています。 画像を読み込むために、例えば、 Dim picture As Shape Set picture = ActiveSheet.Shapes.AddPicture(filename:=filename, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) のように、一旦、画像を「文書とともに保存しない」モードで読込み、後にそのShape画像を「文書とともに保存する」ように変更することは、可能でしょうか。

  • word2003のマクロが2007でエラーになる

    word2003(windows2000)で使っていたマクロを、人に頼まれてその人の2007のword(windowsXP)に入れたのですがエラーが出て動かないそうです。 マクロは以下のページにあったものの改造で、どこを直したらよいのかわかりません。 http://okwave.jp/qa/q2344318.html 答えでなく、ヒントでも良いのでどなたか教えてください。 h = Selection.ShapeRange.Heightという行で、「エラー5 プロシージャの呼び出し、または引数が不正です」というようなエラーが出るそうです。 2003ではエラーは出ず、選択されている画像の高さがhに入ります。 よろしくお願いします。 ----------------------------------- Public Sub ChgPest() '選択した画像をクリップボードの中身と入れ替えてemfで貼り付ける Dim T, L, h, W, cl, cr, ct, cb As Integer Dim FName As String Dim MyShape As Shape Dim fd As FileDialog Dim clp As Integer Application.ScreenUpdating = False T = Selection.ShapeRange.Top L = Selection.ShapeRange.Left h = Selection.ShapeRange.Height ←●デバッグするとここが黄色になっている W = Selection.ShapeRange.Width posi = Selection.ShapeRange.RelativeVerticalPosition cl = Selection.ShapeRange.PictureFormat.CropLeft cr = Selection.ShapeRange.PictureFormat.CropRight ct = Selection.ShapeRange.PictureFormat.CropTop cb = Selection.ShapeRange.PictureFormat.CropBottom Set myrange = Selection.Range Selection.Delete Selection.PasteSpecial datatype:=wdPasteEnhancedMetafile 'EMFでペースト clp = ActiveDocument.Shapes.Count 'すべてのshapeを数える Set MyShape = ActiveDocument.Shapes(clp) '最後にペーストしたshape ActiveDocument.Shapes(clp).LockAnchor = False 'アンカーを固定しない ActiveDocument.Shapes(clp).WrapFormat.Type = 3 MyShape.Select With Selection.ShapeRange.PictureFormat .CropLeft = cl .CropRight = cr .CropTop = ct .CropBottom = cb End With Selection.ShapeRange.RelativeVerticalPosition = posi Selection.ShapeRange.Top = T Selection.ShapeRange.Left = L Selection.ShapeRange.Height = h Selection.ShapeRange.Width = W Selection.ShapeRange.ZOrder msoSendToBack Application.ScreenUpdating = True End Sub

  • wordのマクロでクリップボードの処理

    WORD文書上に、「c:\....jpg」という画像へのアドレスが複数あるとします。そのアドレスを画像に差し替えたいのですがうまくいきません。。 とりあえずマクロでまず「c:\\*jpg」で検索をかけて、文字列をコピー、その文字列を使って図の挿入をしようと思っています。 Sub Macro1() Dim 画像 Selection.Find.ClearFormatting With Selection.Find .Text = "C:\\*jpg" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchFuzzy = False .MatchWildcards = True End With Selection.Find.Execute Selection.Copy ※クリップボードの内容を変数「画像」へ代入 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.InlineShapes.AddPicture FileName:= _ 画像, LinkToFile:=False, SaveWithDocument:= _ True End Sub 以上が今考えているマクロなんですが、※の部分で変数「画像」へクリップボードから代入をする処理がどうにもうまくいきません。 wordのマクロは初めていじるのでよくわかりません。 どなたかわかる方教えてください。よろしくお願いします。

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

    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 ---

  • エクセルでリンクされたイメージが表示できません

    エクセルでリンクされたイメージが表示できませんとたまに表示されます。 この理由はどうしてですか? 画像は下記のVBAを用いてセルC113に貼っています。 Sub 貼付() ActiveWindow.View = xlNormalView Range("C113").Select myFileName = "C:\凡例.bmp" '---挿入する画像ファイルの指定 'Cells(113, 3).Select 'ActiveSheet.Pictures.Insert Filename:=myFileName '---選択位置に画像を挿入 Set myShape = ActiveSheet.Shapes.AddPicture(Filename:=myFileName, _ LinkToFile:=True, SaveWithDocument:=False, Left:=Selection.Left + 50, _ Top:=Selection.Top, Width:=200#, Height:=100#) end sub

  • エクセルのマクロで画像を貼り付け 

    画像をエクセルに貼り付ける作業を行っています。 マクロを使いファイル内の画像(約30枚程度)を1列づつスペースを空け 右方向に4枚 1行スペースを空け 3行目の左に戻り その位置よりまた1列づつスペースを空け右方向に4枚・・・・・ これを繰り返しファイル内の画像をすべて 貼り付けたいのですがうまく動作が出来ません。 何卒ご教授の程よろしくお願いします。 ※マクロ Sub EggFunc_pasteDirImage() ' 変数定義 Dim fileName As String Dim targetCol As Integer Dim targetRow As Integer Dim targetCell As Range Dim shell, myPath Dim pos As Integer Dim extention As String Dim isImage As Boolean ' 選択セルを取得 targetCol = ActiveCell.Column targetRow = ActiveCell.Row ' フォルダ選択画面を表示 Set shell = CreateObject("Shell.Application") Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\Users\0602116.MS\Desktop\") Set shell = Nothing ' フォルダを選択したら... If Not myPath Is Nothing Then fileName = Dir(myPath.Items.Item.Path + "\") Do While fileName <> "" ' ファイル拡張子の判別 isImage = True pos = InStrRev(fileName, ".") If pos > 0 Then Select Case LCase(Mid(fileName, pos + 1)) Case "jpeg" Case "jpg" Case "gif" Case Else isImage = False End Select Else isImage = False End If ' 拡張子が画像であれば If isImage = True Then ' 貼り付け先を選択 Cells(targetRow, targetCol).Select Set targetCell = ActiveCell ' 画像読込み ActiveSheet.Pictures.Insert(myPath.Items.Item.Path + "\" + fileName).Select ' 画像が大きい場合、画像サイズをセル幅に合わせる If Selection.Width > targetCell.Width Or Selection.Height > targetCell.Height Then If Selection.Width / targetCell.Width > Selection.Height / targetCell.Height Then Selection.Height = Selection.Height * (targetCell.Width / Selection.Width) Selection.Width = targetCell.Width Else Selection.Width = Selection.Width * (targetCell.Height / Selection.Height) Selection.Height = targetCell.Height End If End If ' 表示位置をセル中央に移動 Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2 Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2 ' 貼り付け先行を+1 targetCol = targetCol + 2 End If fileName = Dir() Loop MsgBox "画像の読込みが終了しました" End If End Sub

  • ワード2002で「 Selection.ShapeRange.Left 」 が設定できない

    こんにちは。 OSはWinXP Pro、OfficeXPを使用しています。 1ページ目にあるグループ化された図形をページを 追加して貼り付けていくマクロを以前質問したので すが、ShapeRange.Leftの代入がうまくいきません。 ******************************************** Sub 図形追加() Dim siTop As Single Dim siLeft As Single Selection.HomeKey unit:=wdStory ActiveDocument.Shapes("Group 1478").Select siTop = Selection.ShapeRange.Top siLeft = Selection.ShapeRange.Left Selection.Copy Selection.EndKey unit:=wdStory Selection.InsertBreak Type:=wdPageBreak Selection.GoTo What:=wdGoToPage, _ Which:=wdGoToNext Selection.Paste Selection.ShapeRange.Top = siTop Selection.ShapeRange.Left = siLeft Selection.HomeKey unit:=wdLine End Sub ******************************************** 上述の値を追っていくと、 siTop=40.25、siLeft=46が入っているのですが、 下から2段目のShaperange.Leftを実行すると そこには-785.05 という数値が入ってしまいます。 (どこからその数値がでてきたのか????) Shaperange.Topはうまくいくのですが、ステートメント の実行順を変えてもうまくいきません。 どなたか解決策のご教授をお願いします。

  • vbaでメモリ不足となる原因は?

    ワードのマクロを使って、tifファイル500個ほどを読み込もうとしたところ、読み込みの途中で「メモリ不足です」というメッセージが表示されます。 タスクマネージャで確認すると、たしかに50ファイルほど読み込んだところでメモリが2Gを超えてしまっていました。 メモリ不足になる原因と、解決方法を教えていただけますか? ご参考までに作成したマクロと使用しているPCのスペックを追記します。 Sub Macro1() Dim file_path As String Dim file_name As String Dim I As Integer file_path = "C:\Documents and Settings\user\デスクトップ\説明書\ページ" For I = 1 To 500 file_name = file_path + StrConv(I, 1) + ".tif" With ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, FileName:= _ file_name, LinkToFile:=False, SaveWithDocument:=True) .WrapFormat.Type = 3 .ZOrder 5 End With Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak Next I End Sub PCのスペック OS:Windows XP メモリ:2G word:2003 よろしくお願いします。

  • 画像読み込み失敗の判定

    VBA Excel2007を使用しています。 画像をインポートするために、例えば、myPicuter = ActiveSheet.Shapes.AddPicture(filename, true, false, 0, 0, 100,100)を実行した際に、読み込みに失敗するとmyPictureとして添付のような表示が現れますが、このmyPicuterが画像でないことを判定する方法は有るでしょうか。 また、もし直接判定ができなければ、中の文字列を読み出して、その内容から判定する方法はあるでしょうか。

  • PowerPointのVBAで、図形を縮小後、画質を落とさずに出力する方法

    PowerPointのVBAで、スライド上の図形のサイズを縮小した後、この図形をjpg画像として保存したいです。 オペレーションはこんな感じです↓ 図形縮小→図形を選択→右クリック→[図として保存]→JPGファイル名で保存 上記操作を「マクロの記録」で記録したものを実行すると、スライド全体が保存されてしまいます。 また、マクロで.ShapeRange.Exportで画像出力すると、画質が荒くなって出力されます。 画質を落とさず、図形をjpgとして保存する方法はないでしょうか。 よろしくお願い致します。 以下が、現状の私のプログラムです。 Sub Macro() ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="C:\aaaa.JPG", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-119, Top:=-89, Width:=960, Height:=720).Select ActiveWindow.LargeScroll ToRight:=1 With ActiveWindow.Selection.ShapeRange .ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft .ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft End With With ActiveWindow.Selection.ShapeRange .IncrementLeft 219.12 .IncrementTop 416.75 End With ActiveWindow.Selection.ShapeRange.Select 'これだと画質が落ちます。↓ Call ActiveWindow.Selection.ShapeRange.Export("C:\\bbb.jpg", ppSaveAsJPG) 'これだとスライド全体が保存されます。↓ ' ActivePresentation.SaveAs FileName:="C:\bbb.jpg", FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse End Sub

何度やってもWi-Fiに繋げられない
このQ&Aのポイント
  • プリンターMFC-J6583CDWをWi-Fiに繋げられない問題について相談します。
  • Windows10の環境で、無線LAN経由での接続がうまくいきません。
  • バッファローの無線LANルーターWSR-3200AX4Sを使用しており、ひかり回線に接続しています。
回答を見る

専門家に質問してみよう