• 締切済み

VBScrip pdf 開く

VBScriptで、ExcelやWordを開く場合、 Set v = CreateObject("Excel.Application") Set w = CreateObject("Word.Application") Set x = v.Workbooks.Open(u & "\" & "Sample.xlsx") Set y = x.Worksheets(1) Set z = w.Documents.Open(u & "\Sample.docx") などとすると思うのですが、pdfファイルを開く場合、ネット上で調べると Set x = CreateObject("AcroExch.PDDoc") x.Open(u & "\Sample.pdf") というようになっていました。 私がしたいのは、元々Wordで組まれたものが 現在、「InDesign」に読み込まれたデータがあり、 その「InDesign」からpdfに落としたファイルもあります。 修正作業は「InDesign」上で行われ、元のWordのデータは 今は使えません。 修正後の「pdf」ファイルを、もう一度元のWordの形式に戻すのに pdf→Wordの変換を行うと、かなりひどいものになってしまったので、 出来ることなら、pdfの文字を再び、Wordに取り込ませたいのです。 表形式になっているので、pdfのセル内のテキストを読み込み Wordの同じ位置に貼り付けたいのです。 z.Cell(1, 2).Range.Text = Trim(x.Range("D6").Value) z.Cell(2, 2).Range.Text = Trim(x.Range("D8").Value) Excel→Wordのときは、これで出来たので、 こんな感じに処理したいのですが、 分かる方、おられましたら、お教えください。 このお仕事、クライアントからは、元々Excelのデータできて 当初は、それをWordにすれば「OK」ということで、 そのプログラムは簡単に組めたのですが、 さすがにpdfについては、よく分かりません。 以上、よろしくお願い致します。

みんなの回答

回答No.1

開くだけ？ ＶＢＡだと、 Const xPath = "d:\tmp\suh02-j.pdf" CreateObject("Shell.Application").ShellExecute xPath

Prome_Lin
質問者

お礼

お礼が遅くなり大変申し訳ございませんでした。 私のタイトルの付け方が悪かったのですが、開くだけでしたら、上記にあるように Set x = CreateObject("AcroExch.PDDoc") x.Open(u & "\Sample.pdf") で開きます。 私としては、pdfの表のセル内の文字（テキスト）をWordの表の同じ位置に取り込みたいのです。 ありがとうございました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • VBScript Excel Workbooks

    全く下らない質問で申し訳ございません。 あくまでも、興味があったので質問しているだけで、 以下のやり方でなくても、やりたいことが実現できることは 分かっているのですが、教えて頂ければ幸いです。 VBScriptで Option Explicit Dim x, y Set x = CreateObject("Excel.Application") Set y = x.Workbooks.Open("D:\Sample.xlsx").Worksheets(1) ｜ x.Workbooks(1).Close x.Quit Set y = Nothing Set x = Nothing 普通は、 Set y = x.Workbooks.Open("D:\Sample.xlsx") Set z = y.Worksheets(1) として、 y.Close とする方が分かりやすいのは分かっているのですが、 あえて、勉強を兼ねて、上記のように記述しました。 私が知りたい疑問は、Excelのファイルを２つ開いた場合です。 Option Explicit Dim x, y, z Set x = CreateObject("Excel.Application") x.Application.DisplayAlerts = False x.Visible = False Set y = x.Workbooks.Open("F:\Sample.xlsx").Worksheets(1) Set z = x.Workbooks.Add().Worksheets(1) z.Range("A1").Value = y.Range("A1").Value x.Workbooks(1).Close x.Workbooks(2).SaveAs("F:\Test_02.xlsx") x.Workbooks(2).Close x.Quit Set z = Nothing Set y = Nothing Set x = Nothing このプログラムで、 Set y = x.Workbooks.Open("F:\Sample.xlsx").Worksheets(1) の行が無ければ、「x.Workbooks(1).Close」もなく、 その下の行は、 x.Workbooks(1).SaveAs("F:\Test_02.xlsx") x.Workbooks(1).Close となり、問題なく「Test_02.xlsx」ファイルが出来ていました。 ファイルを２つ開いたので、「Workbooks(2)」となる、 と思ったのですが、どうやら違うようです。 （「インデックスが有効範囲にありません」というエラーになります） 何度も言いますが、こんなことで悩む必要がないのは 分かっているのですが、何か気になります。 上記のやり方で、Excelのファイルを２つ開いている場合の ２つ目のファイルを閉じる方法を教えてください。 ホント、下らない質問で申し訳ございませんが よろしくお願い致します。 以上

  • VbscriptによるExcelのコピー＆ペースト

    いつもお世話になります。 教えて頂きたいのは、 「VBScript」でExcelのセルの内容をコピー＆ペーストしても、 オートシェイプなどがペーストされません。 どうすれば、すべての内容をペーストできるでしょうか？ （分かりにくい変数名で申し訳ございません） Option Explicit Dim v, w, x, y, z Set v = CreateObject("Excel.Application") Set w = v.Workbooks.Open("E:\Test\Original.xls") Set x = w.Worksheets(1) Set y = v.Workbooks.Open("E:\Test\Result.xls") Set z = y.Worksheets(1) v.Application.DisplayAlerts = False x.Range("A1:U55").Copy z.Range("A1:U55").PasteSpecial(-4104) x.Range("AB1:AF55").Copy z.Range("V1:Z55").PasteSpecial(-4104) y.SaveAs("E:\Test\ResultPaste.xls") y.Close w.Close v.Quit Set z = Nothing Set y = Nothing Set x = Nothing Set w = Nothing Set v = Nothing MsgBox("Finished") 上記のプログラムで、「Original.xls」の内容を 「Result.xls」にコピー＆ぺーストしたいのですが、 セル内の文字情報はフォントや文字の大きさ（サイズ）、 セルの表示形式などがちゃんとペーストされたのですが、 「Original.xls」にあるテキストボックスや オートシェイプはペーストされませんでした。 すべての内容をペーストするには、 どうすれば良いでしょうか？ よろしくお願い致します。

  • VBScript ワードunicodeテキスト保存

    大量のワードのファイルをテキスト保存する仕事が入り、フォルダ内にあるワードファイルをテキスト保存し、テキストボックスやオートシェープの中のテキストも抜き出すプログラムを「VBScript」で作りました。 テキスト保存する際、Unicode形式で保存しなければならず、調べると、「SaveAs …, 7」がUnicodeによるテキスト保存だと分かったのですが、実際にやってみると、拡張子が「.rtf」ファイルだけが、Unicodeによるテキスト保存され、「.doc」や「.docx」は、「シフトJIS」保存されてしまいました。 私、何か間違っているのでしょうか？ 以下、一応、プログラムをコピーしておきます。 問題の部分は「行１３」です。 なお、ワードは「Word2010」です。 01　Option Explicit 02　Public a, b, c, d, e, f, g, h, t, u, v, w, x, y, z 03　Set w = CreateObject("Word.Application") 04　w.Application.DisplayAlerts = False 05　w.Visible = False 06　Set x = CreateObject("Scripting.FileSystemObject") 07　Set y = x.GetFolder(".") 08　For Each a In y.Files 09　b = LCase(x.GetExtensionName(a.Name)) 10　If b = "doc" or b = "docx" or b = "rtf" Then 11　h = x.GetBaseName(a.Name) 12　Set z = w.Documents.Open(y & "\" & a.Name) 13　z.SaveAs y & "\" & h & ".txt", 7 14　z.Close 15　Set z = Nothing 16　End If 17　If b = "docx" Then 18　Set z = w.Documents.Open(y & "\" & a.Name) 19　z.SaveAs y & "\qkza934irs2801wuptc56ynv7bm.doc", 0 20　z.Close 21　Set z = Nothing 22　Set z = w.Documents.Open(y & "\qkza934irs2801wuptc56ynv7bm.doc") 23　Call o 24　z.Close 25　Set z = Nothing 26　x.DeleteFile(y & "\qkza934irs2801wuptc56ynv7bm.doc") 27　ElseIf b = "doc" or b = "rtf" Then 28　Set z = w.Documents.Open(y & "\" & a.Name) 29　Call o 30　z.Close 31　Set z = Nothing 32　End If 33　If f > "" Then 34　Set t = x.CreateTextFile(y & "\TB_" & h & ".txt", True, True) 35　t.Write f 36　t.Close 37　End If 38　Next 39　w.Quit 40　Set z = Nothing 41　Set y = Nothing 42　Set x = Nothing 43　Set w = Nothing 44　MsgBox("Finished!") 45　Sub o 46　f = "" 47　For Each c In w.ActiveDocument.Shapes 48　If c.Type = 1 or c.Type = 17 then 49　Set v = c.TextFrame 50　e = v.TextRange 51　f = f & e 52　Set d = Nothing 53　ElseIf c.Type = 6 Then 54　For Each g In c.GroupItems 55　Set u = g.TextFrame 56　e = u.TextRange 57　f = f & e 58　Set u = Nothing 59　Next 60　End if 61　Next 62　End Sub よろしく、お願いします。

  • 新たに作成したシートでunion関数が使えないのですが。

    困っています 例えば Option Explicit Sub sss() Dim allrange As Range Dim cell As Range Set allrange = Union(Range("A1"), Range("A3")) For Each cell In allrange cell = 123 Next cell End Sub '---------------------------------------------------------- Sub ssscr() Dim exlapp As Excel.Application Dim exlwb As Object Dim exlsh As Object Set exlapp = CreateObject("Excel.Application") exlapp.Visible = True Set exlwb = exlapp.Workbooks.Add Set exlsh = exlwb.Worksheets(1) Dim allrange As Range Dim cell As Range Dim rngA1 As Range Dim rngA3 As Range Set rngA1 = exlsh.Range("A1") Set rngA3 = exlsh.Range("A3") Set allrange = Union(rngA1, rngA3) For Each cell In allrange cell = 123 Next cell End Sub 最初のコードだとA1,A3に値が入力されるんですけど 二番目のコードだと新たに出来きたbookに入力されません。 unionのところでエラー起こります。 作成したブックのシートをセレクトしても入力できません。 作成したブックにunion関数を指定したときどうしたらよろしいでしょうか？

  • VBScriptでExcel（インデックスが…）

    昨日も質問をしたばかりで、自分でも情けないのですが… （すみません、２つ分からないことがあります。） VBScriptでExcelのファイルの中身を 別のファイルにコピーするプログラムを作りました。 見にくい変数名で申し訳ないのですが、 これを実行すると、17行目で 「インデックスが有効範囲にありません」 というエラーメッセージが出て止まってしまいます。 しかし、ここで「Set」しているファイルは 「Original.xls」というファイルなのですが、 シートは20個あります。 この20個という数は、絶対にあり得ない数で、 読み込み側のファイルのシートは最大で17個ですので、 数が足りないはずはありません。 だいたい、「インデックス…」というのは配列変数と思って 処理しているのでしょうか？ 何より、プログラムの最初の方に 「On Error Resume Next」を置くと、 このプログラムの所期の目的である、 読み込んだファイルの中身を 「Original.xls」にペースとして ファイル名をかえて保存する というのは実現できています。 ２つ目の問題は、 22行目から24行目で 「Original.xls」の不要なシートを削除しているのですが、 途中に「MsgBox」を置いて、 「s」や「i」の値を調べてみても問題はないのに、 シートが１つしか残りません。 例えば、読み込んだファイルのシートの数が３なら 「s + 1 = 4」ですから、この「For～Next」ループは 「4～20」までの17回実行され、 その間、常に４番目のシートを削除し続け、 結果として、必要な１～３のシートが残るはずなのですが、 常に19個削除されてしまいます。 本来は、「Original.xls」のシートの数は１つにしておいて、 必要な数だけ、その１つのシートをコピーで増やしたかったのですが、 それも分からず、仕方なしにこんなやり方をしました。 やはり、そのやり方でないと、ダメなのでしょうか？ 以上、ややこしい質問で申し訳ないのですが、 お分かりの方がおられましたら、お教えください。 Option Explicit '01 Dim d, i, s, t, u, v, w, x, y, z '02 Set t = CreateObject("Scripting.FileSystemObject") '03 Set u = t.GetFolder(".") '04 Set v = CreateObject("Excel.Application") '05 Set w = v.Workbooks.Open(u & "\Result\Original.xls") '06 '07 v.Application.DisplayAlerts = False '08 v.Visible = False '09 '10 For Each d In u.Files '11 If t.GetExtensionName(d.Name) = "xls" Then '12 Set x = v.Workbooks.Open(u & "\" & d.Name) '13 s = x.Worksheets.Count '14 For i = 1 to s '15 Set y = x.Worksheets(i) '16 Set z = w.Worksheets(i) '17 z.Name = y.Name '18 y.Range("A1:U55").Copy z.Range("A1") '19 y.Range("AB1:AF55").Copy z.Range("V1") '20 Next '21 For i = s + 1 to 20 '22 .Worksheets(s + 1).Delete '23 Next '24 x.SaveAs(u & "\o_" & d.Name) '25 w.SaveAs(u & "\Result\" & d.Name) '26 x.Close '27 End If '28 Next '29 '30 v.Quit '31 Set z = Nothing '32 Set y = Nothing '33 Set x = Nothing '34 Set w = Nothing '35 Set v = Nothing '36 Srt u = Nothing '37 Set t = Nothing '38 '39 MsgBox("Finished") '40 よろしく、お願い致します。

  • VBScript pdfファイル結合

    VBScriptでpdfファイルを結合するプログラムがネット上にあったので、そのプログラムを使ってpdfファイルの結合をしました。 しかし、出来上がったpdfの容量がやけに小さいので、プロパティを見ると、何故か、「Web表示用に最適化：はい」になっていました。 このプログラムは、最初に「新規のページ」を作って、そこに既存のファイルを挿入していく、というものでした。 既存のファイルはすべて「Web表示用に最適化：いいえ」なのですが、どうやら、「新規のページ」で作ったページが「はい」になっているため、最適化されてしまうみたいです。 しかし、私は「Acrobat」を通常使うのプリンタに設定して、何の設定変更もなしに（保存場所だけは、そのたびごとに変わるが）、ワードなどのファイルをpdfに出力すると、「Web…」は、「いいえ」のファイルができます。 従って、私のデバイスドライバとしての「Acrobat」の標準の設定は「Web…」は、「いいえ」のはずなのに、「はい」のページが「Create」されてしまうのは、なぜなのでしょう。 というより、私が知りたいのは、元ファイルのまま、pdfファイルを結合したいのです。 印刷関係の仕事をしていますので、dpiなどが変わる事は許されません。 なお、プログラムは Set y = CreateObject("AcroExch.PDDoc") y.Create←ここで「Web…：いいえ」のページを作成したい！ Set z = CreateObject("AcroExch.PDDoc") For i = 0 to c z.Open(e(i))←「フォルダ名＆ファイル名のデータ」 y.InsertPages -2, y, 0, z.GetNumPages, False z.Close Next y.Save 5, v & "\Result.pdf" y.Close 詳しい方、よろしくお願い致します。

  • VBAで、エクセルからワードへの変換について

    VBAは、全くの初心者で、テキスト等のサンプルコードを参照して書いているのですが 期待通りの動きをしないので、教えてください。 やりたい事は、Excelファイル（A-Fカラム、400行程度）を 1行ページのワードに変換し、400枚のワードファイルを作成します。 その際に、添付画面のように、各カラムを、タイトル、連番、内容などと区分けをして フォントも変えたいです。 下のコードでは、転送は、出来るのですが、1行1ページにならず、また、 エクセルの枠も転送されてしまいます。 ワードVBAも試したのですが、特定文字での検索が難しく、各ページでの 改行位置が異なるため、自分の理解では出来ませんでした。 ワードでテンプレートを作って、Excel VBAから差込になるのでしょうか？ よろしくお願い致します。 Sub CopyExcelDataToWord() Dim wsSource As Excel.Worksheet Dim cell As Excel.Range Dim collUniqueHeadings As Collection Dim lngLastRow As Long Dim i As Long Dim appWord As Word.Application Dim docWordTarget As Word.Document Set wsSource = ThisWorkbook.Worksheets(1) With wsSource lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row Set collUniqueHeadings = New Collection For Each cell In .Range("A2:A" & lngLastRow) On Error Resume Next collUniqueHeadings.Add Item:=cell.Value, Key:=cell.Value On Error GoTo 0 Next cell End With Set appWord = CreateObject("Word.Application") With appWord .Visible = True Set docWordTarget = .Documents.Add .ActiveDocument.Select End With For i = 1 To collUniqueHeadings.Count With wsSource .Range("A1").AutoFilter Field:=1, Criteria1:=collUniqueHeadings(i) .Range("A1:D" & lngLastRow).Copy End With With appWord.Selection .PasteExcelTable linkedtoexcel:=False, wordformatting:=True, RTF:=False .TypeParagraph End With Next i For i = 1 To collUniqueHeadings.Count collUniqueHeadings.Remove 1 Next i Set docWordTarget = Nothing Set appWord = Nothing End Sub

  • Cell内の一部を指定する方法(Word VBA)

    Cell内の一部を指定する方法(Word VBA) Word VBAで、特定のCellの中の一部だけを指定するには、どうすればいいのでしょうか。 たとえば、ある表のCell(1, 2)の6～10文字目を指定して、そこだけを太字にするために、 Set Date1 = Table1.Cell(1, 2).Range(Start:=5, End:=10) としても、RangeメソッドはCellに使えないようなので、エラーになってしまいます。

  • ACCESSのVBAからExcelのセルから読めたのですが、書く方法を教えてください

    下記の方法でCell(1,1)、から読むことができました そこで今度書き込みなのですが With xlBk.Worksheets("Sheet1") 　　　'Debug.Print .Cells(1,1) 　　　.Cell(1,2) = "data" End With としても、エクセルシートには書かれていないのですが 書く方法を教えてください ただ、下記の Open(Filename:=strFile, UpdateLinks:=0) はエクセルをOpenする時 「このブックは他のデータソースへのリンクがふくまれています」 とメッセージがでるので、UpdateLinks:=0、と入れています よろしくおねがいします '--------------------------------- Dim xlApp As Excel.Application Dim xlBk As Excel.Workbook Dim strFile As String strFile = "C:\Sample\Book1.xls" Set xlApp = CreateObject("Excel.Application") Set xlBk = xlApp.Workbooks.Open(Filename:=strFile, UpdateLinks:=0) With xlBk.Worksheets("Sheet1") 　　Debug.Print .Cells(1,1) End With xlBk.Close False xlApp.Quit Set xlApp = Nothing '----------------------------------

  • VBAからPDFのテキストフィールド

    Excelに入力されたデータをVBAでPDFのテキストフィールドへデータを自動で入力したいのですが、いろいろ探してみたものの、それらしきサンプル等もなく困窮しています。 例えばExcelに名前が100人登録されているとして、これを順番にPDFのテキストフィールドへ自動的に入力（更新）し、印刷する。（100人分が完了するまで） といった感じの内容です。 まったくわかりませんので、どなたかお教え下さい。 もしサンプルコードが存在するようでしたらURLをお教えいただけると助かります。 宜しく御願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する