VBAを使用してエクセルの表をワードに自動入力する方法

このQ&Aのポイント
  • Excel/Word2002を使用して、VBAを使ってエクセルの表をワードのテンプレートに自動入力する方法について教えてください。
  • 具体的には、エクセルのA1:C8のセルに入力された表をコピーして、ワードのテンプレートに貼り付ける方法を知りたいです。
  • また、特定のテンプレートのパス名を指定してワードを立ち上げる方法についても教えてください。
回答を見る
  • ベストアンサー

VBAでエクセルの表をワードに入力

Excel/Word2002使用です。 ワードへの入力を自動化するためにVBAを使用してエクセルの表をワードのテンプレートに渡したいのですが。 エクセルのA1:C8のセルに表として値が入力されています。 この表をコピーしてワードに貼り付けます。 ワード側は何も入力されていない文書ですが、 テンプレートが用意されているので、このテンプレートを指定してワードを立ち上げます。 ワードに貼り付けられる表はタブ区切りです。 具体的には下記コード3行目の”winword.exe”を具体的なテンプレートのパス名にしたいのですが・・・ Sub word貼り付け() Dim mytskID As Double Range("A1:C8").Copy  mytskID = Shell("winword.exe", vbNormalFocus)  Application.Wait Now + TimeValue("00:00:10")  Application.SendKeys "^v", True  Application.Wait Now + TimeValue("00:00:10")  Application.SendKeys "%fa", True  Range("A1").Copy  AppActivate mytskID  Application.SendKeys "^v", True  Application.SendKeys "~", True  Application.Wait Now + TimeValue("00:00:05")  Application.SendKeys "%fx", True  Application.CutCopyMode = False MsgBox "完了しました" End Sub なお、上記コードも教科書通りにしたはずなのですが、 何故か「名前をつけて保存」のSendKeys "%fa"のときだと思うのですが、 ワード側ではファイルメニューの罫線が反応してしまいます。 あわせてご教授いただければ幸いです。 よろしくお願いします。

  • ken123
  • お礼率73% (299/409)

質問者が選んだベストアンサー

  • ベストアンサー
  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.3

追加です。 環境をよく見ていなかったので。 .Paste はEXCEL2000以前で Excel2002の場合は .PasteExcelTable True, False, True です。

ken123
質問者

お礼

o_chi_chi様 早速のご回答ありがとうございます。 万事うまくいきました。 大変助かりました。 pasteもエラーがかかっていて悩んでおりました。 今後ともよろしくお願いします。

その他の回答 (2)

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.2

"テンプレート"にフルパスを設定していますか。 appWDApp.Documents.Open Filename:="C:\Templates.dot"

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.1

下記のようにワードオブジェクトを生成して 起動したほうが扱いやすくないですか。 ただワードマクロは使った事がないので。。。 --- Sub mCopy() Dim appWDApp As Word.Application Dim objWDDoc As Object Dim rngRange As Range Set rngRange = Application.Range("A1:C8") Set appWDApp = New Word.Application Application.Wait Now + TimeValue("0:00:05") appWDApp.Visible = True appWDApp.Documents.Open Filename:="テンプレート" AppActivate appWDApp.Caption Set objWDDoc = appWDApp.ActiveDocument With objWDDoc With .ActiveWindow.Selection .EndOf Unit:=wdStory, Extend:=wdMove .HomeKey Unit:=wdLine, Extend:=wdExtend rngRange.Copy .Paste Application.CutCopyMode = False End With End With Set appWDApp = Nothing Set objWDDoc = Nothing Set rngRange = Nothing End Sub

参考URL:
ken123
質問者

お礼

↑↑ 参照設定はわかりました。microsoft Word ** Object Library でいけました。ありがとうございます。 しかし、 >appWDApp.Documents.Open Filename:="テンプレート" でアプリケーション定義エラーとなってしまいます。できましたら追加のアドバイスをお願いします。

ken123
質問者

補足

o_chi_chi様早速のご回答ありがとうございます。 一行目の >Dim appWDApp As Word.Application で、コンパイルエラー 「ユーザー定義型は定義されていません」 のエラー表示となるのですが・・・ ネットで調べると参照設定の必要があるようなのですが、ご教授いたけませんでしょうか? ご多忙中誠に恐縮ですがよろしくお願いします。

関連するQ&A

  • EXCEL VBA IEからダウンロード

    まず以下のコードを見てください(一部を抜粋) objIE.Navigate URL02 Do While objIE.Busy = True DoEvents Loop objIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT objIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") objIE.Quit Worksheets("商品情報").Select Range("A2:J100").Clear Range("A2").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v", True とりあえずこれで使えてはいるのですが、これだと一度IEを終了することになるので、終了せずにエクセルのシートにペーストしたいと思いobjIE.Quitを削除しました。 そうしたらコピーまではするのですがペーストしなくなってしまいました。 なんとかIEを起動したままでペーストしたいのですが、どう直したらいいですか?教えてください。 宜しくお願いします。

  • エクセルVBAの値貼り付けについて

    いつもお世話になっております。 エクセルVBAについての質問ですが 以下のコードを使用するとどうしても元の書式の貼り付けになってします。 値(テキスト)貼り付けを実行したいのですがどこのコードをどのように変えればいいか教えてください。 ------------------------------------------------------------------------------------------- Sub IE_Open_Copy() Dim objIE As Object Const OLECMDID_SELECTALL = 17 Const OLECMDID_COPY = 12 Const OLECMDEXECOPT_DODEFAULT = 0 Const URL As String = "https://okwave.jp/question/" Set objIE = CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate URL Do While .Busy DoEvents Loop Do Until .ReadyState = 4 DoEvents Loop .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") .Quit End With AppActivate Application.Caption, True Range("A1").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v" Set objIE = Nothing End Sub ---------------------------------------------------------------------------------------------

  • Excelの三つのVBAを一つにまとめる。

     初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________  解る方、よろしくお願いします。

  • VBA 特定SVRにID,PASSを投入したい

    現在 グループ外のSVRに 下記 を使ってID,PASSを投入しておりますが 成功率があまり高くありません。 この起動EXCEL を保存しますか? 等 違う画面がでてしまいます。 他に良い方法があればご教授お願いいたします。 Dim myid As Long If Application.OperatingSystem = "Windows (32-bit) NT 5.00" Then 'windows2000 myid = Shell("c:\winnt\explorer.exe", vbNormalFocus) Else myid = Shell("c:\windows\explorer.exe", vbNormalFocus) End If If myid <> 0 Then Application.Wait Now() + TimeValue("00:00:02") SendKeys "%d", True SendKeys "\\xxx.xxx.xxx.xxx", True 'IPアドレス SendKeys "{enter}", True Application.Wait Now() + TimeValue("00:00:01") SendKeys "%u", True SendKeys "xxxxxxx", True 'ID SendKeys "{enter}", True SendKeys "%p", True SendKeys "xxxxxxxx", True 'PASSWORD SendKeys "{enter}", True SendKeys "%fc", True Application.EnableEvents = True Else MsgBox "xxxSVR接続に失敗しました。" & vbCrLf & "再度実行して下さい。" End If

  • Word VBAにwaitに準ずる機能を使いたい

    はじめまして。 複数の部署へ配布する用に大量の印刷を行っています。 以下のことをやりたいのですが、application.WaitがWordでは使えず困っています。 やりたいこと: 作成したWord文書を、コピー機(1)・コピー機(2)から交互に出力したい。 (1)と(2)の出力の間に、30秒ごとの時間を置いて出力されるようにしたい。 書いたVBA: =================== Sub テクニカルインフォメーション() '回覧紙配布のため、1号機と2号機で出力をします。 ' '  Dim waitTime As Variant   ActivePrinter = "TF1号機_1" '代営TI 60部   Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=60, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 waitTime = Now + TimeValue("0:00:30") Application.Wait waitTime   ActivePrinter = "8FMFP_2" '法規 19部   Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=19, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 waitTime = Now + TimeValue("0:00:30") Application.Wait waitTime ActivePrinter = "TF1号機_1" '代営FF 43部   Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=43, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 waitTime = Now + TimeValue("0:00:30") Application.Wait waitTime   ActivePrinter = "8FMFP" '高機能SC 40部   Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=40, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 End Sub =================== 前任者が残したExcelのVBAを参考にしたのですが、 動かずに大変困っています。 ご教授頂けないでしょうか。 いままでVBAはほとんど触ったことがなく、マクロの記録で乗り越えてきたので 基礎構文もよく理解をしていません。 不勉強で大変申し訳ないのですが、どうかよろしくお願い致します。

  • エクセル VBA 自動処理の途中終了について

    エクセルで単語のフラッシュカードを自動表示させたいと考えています。 エクセルの1セルの大きさを縦最大、横120位に広げ、C列に単語、D列に意味を縦に並べ、 C2 1秒後 D2 1秒後 C2 1秒後 D2 1秒後  C3 1秒後 D4 のように単語と意味を交互に2度ずつ表示させます。 For Next を使い表示はできるようになりましたが、途中で止めたいときに、escを押すと For Nextの処理を最後まで一気に行ってから止まってしまいます。 C5を表示していたら、その場所でPause をし、スタートボタンで再度継続して表示したいと思います。また、単語や意味のセルにはそれぞれ別の文字装飾をしてあるので、(赤や青、大きさなど) セルを移動して表示したいと考えています。 実は他のサイトでも質問しましたが、思ったような回答を得られませんでした。よろしくお願いします。 Sub セル移動() Dim waitTime As Variant i = 0 Range("c2").Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Range("c3").Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime For i = 1 To 50 ActiveCell.Select Selection.Offset(0, 1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(0, -1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(0, 1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Selection.Offset(1, -1).Select waitTime = Now + TimeValue("0:00:01") Application.Wait waitTime Application.OnKey ("{esc}"), "shuryo" i = i + 1 Next i End Sub Sub shuryo() Application.ScreenUpdating = False Range("c2").Select Application.GoTo reference:=ActiveCell, scroll:=True Application.ScreenUpdating = True Exit Sub End Sub

  • ExcelのVBAで、順次動作の実現

    Excelのシートに、トグルボタンを3つ配置します。 ToggleButton1~3 そして、次のマクロを実行すると、2秒ごとに順番にトグルボタンが押されるのかと思いきや、6秒後に一斉にトグルボタンがへっこみます。 どうにか?2秒ごとに順番にトグルボタンが押されるように出来ないでしょうか? Sub test() Dim MyWait As String MyWait = 2 ToggleButton1.Value = True Application.ScreenUpdating = True DoEvents 'この間にもマクロを入れたい(0.1秒以内に処理できるものです) Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton2.Value = True DoEvents Application.Wait (Now + TimeValue("0:00:" & MyWait)) ToggleButton3.Value = True Application.ScreenUpdating = True DoEvents End Sub

  • エクセルにpdfのテキストを表示させたい

    色々やってみたのですがうまくいかないので質問させてください。 エクセルで直接pdfのテキストを表示させるスマートな方法はありませんでしょうか? エクセルで編集するために元データのpdfファイルのテキストを取り込みたいのです。 Sub test() Dim strFilePath As String strFilePath = Application.GetOpenFilename _ ("PDFファイル,*.pdf", MultiSelect:=False) Call Shell("explorer.exe " & strFilePath)  Application.Wait Time:=Now + TimeValue("00:00:05")  Application.SendKeys "^a"  Application.Wait Time:=Now + TimeValue("00:00:03")  Workbooks(1).Activate  Application.SendKeys "^c" End Sub まったく動かないのですが今はこんな感じになっています。

  • アクセスVBA 時間を止める

    エクセルでは動くのですがアクセスで Application.Wait (Now + TimeValue("00:00:01")) を実行すると 「Wait」メソッドまたはデータ メンバが見つかりません。 (Error 461) となってしまいます。 「Wait」にかわる何かがあるのでしょうか? 宜しくお願い致します。

  • エクセルVBA

    VBAの素人です。 以下のようなVBAを実行しようと、何とか形にしました。 単独のBOOKではうまくいくのですが、同時に他のBOOKを開くと 「インデックスが有効範囲にありません」とエラーになります。 エラー箇所は、With Sheets("Sheet1").Range("B1")部分です。 修正をご教示頂ける方、何卒よろしくお願い致します。 全くVBA無知なのにすみません。 Private Sub Workbook_Open() test01 test02 Application.OnTime Now + TimeValue("00:10:00"), "終了" End Sub Sub 終了() Application.OnTime Now + TimeValue("0:00:02"), "test01", , False ThisWorkbook.Close Savechanges:=False Application.Quit End Sub Sub test01() With Sheets("Sheet1").Range("B1") .Value = Time .NumberFormatLocal = "mm:ss" End With Application.OnTime Now + TimeValue("0:00:02"), "test01" End Sub Sub test02() With Sheets("Sheet1").Range("B2") .Value = Time .NumberFormatLocal = "mm:ss" End With End Sub

専門家に質問してみよう