教えて!gooにおける不適切な投稿への対応について

PDFファイルをコピーしてエクセルブックにはりつけるVBAをかきました。
これをフォルダ内にあるすべてのPDFを順にエクセルブックに張り付けるやり方を
おしえていただけないでしょうか。




Sub StartAdobe()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe As Long

AdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
AdobeFile = "C:\Users\admin\test\test.pdf"

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)

Application.OnTime Now + TimeValue("00:00:05"), "FirstStep"

End Sub

Private Sub FirstStep()

SendKeys ("^a")
SendKeys ("^c")

Application.OnTime Now + TimeValue("00:00:10"), "SecondStep"

End Sub

Private Sub SecondStep()

VBA.AppActivate Excel.Application.Caption
Windows("Book1.xlsm").Activate
Range("A1").Activate

SendKeys ("^v")

End Sub

質問者からの補足コメント

  • へこむわー

    自分で1から書くことができないんです・・・
    差支えなければ、書いては頂けないでしょうか

    No.1の回答に寄せられた補足コメントです。 補足日時:2016/03/17 18:14
  • うーん・・・

    ありがとうございます!ただこれだと画像になってしまっていて、
    僕がとりたいのはテキストをコピーしたいんです・・・
    できないでしょうか?

    No.2の回答に寄せられた補足コメントです。 補足日時:2016/03/18 09:30
  • へこむわー

    無理やり Cntl+a Cntl+c でVBAをつくることはできますか
    申し訳ないのですが、できたら作って頂けないでしょうか

    No.3の回答に寄せられた補足コメントです。 補足日時:2016/03/18 11:52
  • うーん・・・

    ありがとうございます。1,2個のファイルだと動いたのですが、10個ぐらいになると
    うまく張り付けられなくなりました。。やっぱり難しいですかね・・

    No.4の回答に寄せられた補足コメントです。 補足日時:2016/03/18 18:13
  • どう思う?

    これはVBA以外のプログラムだったらできたりするものなのでしょうか?

      補足日時:2016/03/19 10:54
gooドクター

A 回答 (5件)

PFDをテキストやExcelに変換するソフトがあるようなので、ググってみて下さい。


この辺を使えば、ご希望のことができるかもしれません。
    • good
    • 2

無理やりです。

動作保証はできません。(私の環境では一応動きましたが・・・)
もし、低スペックのPCで実行するようであれば、Wait時間などを調整してみて下さい。
ご検討をお祈りします。

Sub sample2()
Dim MeApp As String
Dim AdobeApp As String
Dim AdobePath As String
Dim AdobeFile As String
Dim StartAdobe As Variant

MeApp = Application.Caption
AdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe"
AdobePath = "C:\Users\admin\test\"
AdobeFile = Dir(AdobePath & "*.pdf")

Do While AdobeFile <> ""
ThisWorkbook.Sheets("Sheet1").Range("A1").Copy
On Error GoTo ErrorHandler
StartAdobe = Shell("" & AdobeApp & " " & AdobePath & AdobeFile & "", 1)
AppActivate StartAdobe, False
On Error GoTo 0
SendKeys ("^a"), True
SendKeys ("^c"), True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("%{F4}"), False

AppActivate MeApp, True
Worksheets.Add.Name = AdobeFile
ActiveSheet.Paste
Range("A1").Select

AdobeFile = Dir
Loop
Exit Sub
ErrorHandler:
Application.Wait (Now + TimeValue("0:00:03"))
Resume Next
End Sub
この回答への補足あり
    • good
    • 0

気持ちはわかるのですが、ちょっと無謀な気がします。


そもそもPDFはテキストではないです。仮に、mackojiさんがコピーしようとしているPDFでは、テキスト扱いでコピペができたとしても、すべてのPDFでできるとは限りません。
それから、Cntl+aで選択できるのは、表示中のページだけだったりしませんか?複数ページがある場合は、次ページ操作をしてコピーする必要がある等、難問だらけですよね?
どこまで妥協できるかにもよりますが、私なら諦めます。
この回答への補足あり
    • good
    • 0

SendKeysでのコピペは最終手段ですよ。

できれば避けたいところです。
そこで、こんなのはどうでしょうか。
普通の操作でいうと、新しいシートを追加して「挿入」-「オブジェクト」-「ファイルから」でPDFを張り付けるイメージです。それをDir関数でファイル名を取得しながらループしています。
検索対象のフォルダは、ThisWorkbook.Path です。

Sub sample()
Dim MyPathName
Dim MyFileName
Dim MyPDF
MyPathName = ThisWorkbook.Path & "\"
MyFileName = Dir(MyPathName & "*.pdf")
Do While MyFileName <> ""
Worksheets.Add
Set MyPDF = ActiveSheet.OLEObjects.Add(Filename:=MyPathName & MyFileName, _
Link:=False, DisplayAsIcon:=False)
MyFileName = Dir
Loop
End Sub
この回答への補足あり
    • good
    • 0

Dirメソッドを使う

この回答への補足あり
    • good
    • 0

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

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

gooドクター

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

人気Q&Aランキング