- 締切済み
VBAでExcelファイルのPDF自動化
mitarashiの回答
- mitarashi
- ベストアンサー率59% (574/965)
xl2007以降なら、#1さんの例の様に話は簡単なのですが、xl2003以前で、Acrobatを用いて行おうとするとなかなか骨です。 下記リンクがお役に立つのではないかと思います。 http://okwave.jp/qa/q4847920.html http://okwave.jp/qa/q6205938.html リンク先に"プリンタ名"on NeXXの取得をレジストリから行う部分もありますが、お示しのコードは泥臭いけれど簡便で良いですね。 行っている事の解説はこちらにあります。今日検索していてたまたま辿り着きました。 http://helpx.adobe.com/jp/legacy/kb/511120.html ただ、 >デスクトップにファイルをExcelのブック名と同じ名前でPDFに変換するところまで出来ました。 で良いのなら、セルから読んだ名前に付け替えれば簡単かと思います。 保管場所も同様で、カレントディレクトリに出力されるのかどうか分かりませんが、目的の場所にコピーまたは移動してやればよろしいのではないでしょうか。 以上、ご参考まで。
関連するQ&A
- EXECL VBAにて自動印刷１００枚でフリーズ
フィリーズの原因 とりあえず、アクティブプリンターのみで印刷を連続すると異常なし 交互に印刷すると今度はリソース不足が出ました。 最後に、EPSON LPプリンターのみに連続印刷でやはりリソース不足が出ました。 どうもアクティブプリンターからの切替でリソースを必要としているみたいですが 対策はをご教示下さい。 ======================================== Sub チェンジプリンター() '印刷切り替え Dim myPrinter As String myPrinter = Application.ActivePrinter '現在のプリンターを記憶 If Worksheets("DeviceRead-Write").Cells(6, 13).Value = 2 Then 'I6が２ならEPSON_2プリンターに印刷する Application.ActivePrinter = "EPSON_2 on Ne00:" 'プリンターを切り替える ActiveSheet.PrintOut 'シートFormの印刷 Application.ActivePrinter = myPrinter 'プリンターを元に戻す End If If Worksheets("DeviceRead-Write").Cells(6, 13).Value = 1 Then 'I6が1ならEPSON LPプリンターに印刷する ActiveSheet.PrintOut 'シートFormの印刷 End If End Sub ==========================================
- 締切済み
- オフィス系ソフト
- エクセルVBAでPDFを1枚目のみ印刷したい
下記のVBAに複数PDFが重なっている場合は、一枚目のみ印刷する文面を 挿入したいのですがうまくいきません Sub Test() Dim z As Object Dim i As Long Dim f, p As String Application.ScreenUpdating = False Set z = CreateObject("WScript.Shell") p = Application.ActivePrinter For i = 1 To Range("A1").End(xlDown).Row f = "h:\hozei\" & Cells(i, 1).Value & ".pdf" If Dir(f) <> "" Then z.Run ("AcroRd32.exe /t " & f) Else Cells(i, 2).Value = Cells(i, 1).Value Cells(i, 1).Value = "" End If Next i Set z = Nothing End Sub お忙しいところ申し訳ございません どなたかご教示願います。
- ベストアンサー
- Visual Basic
- Execl VBA UserForm1の印刷先
Execl VBA UserForm1の印刷先を変更したいのですが Execl VBAで困っています。 UserFormの印刷を条件を変えてプリンター１とプリンター２に振り分けたいのですが ネットを検索してもいい方法が見つかりません。 UserFormはOSのプリンターを参照するため思うように印刷できません。 一度下記を試しましたが、試通常使うプリンターでしか印刷出来ません UserFormのプリンター切替方法のご伝授宜しくお願い致します。 =========================================== Sub チェンジプリンター() Dim myPrinter As String myPrinter = Application.ActivePrinter '現在のプリンターを記憶 If Worksheets("DeviceRead-Write").Cells(6, 11).Value = 2 Then 'Ｉ６が２ならEPSON_2プリンターに印刷する Application.ActivePrinter = "EPSON_2 on Ne02:" 'プリンターを切り替える Range("A4").Value = Application.ActivePrinter 'プリンターの確認 UserForm1.PrintForm 'フォームの印刷 Application.ActivePrinter = myPrinter 'プリンターを元に戻す Range("A2").Value = Application.ActivePrinter 'プリンターの確認 End If If Worksheets("DeviceRead-Write").Cells(6, 11).Value = 1 Then 'Ｉ６が２ならEPSON_1プリンターに印刷する Range("D2").Value = Application.ActivePrinter 'プリンターの確認 UserForm1.PrintForm 'フォームの印刷 End If End Sub
- 締切済み
- オフィス系ソフト
- エクセルVBAのイベントで質問です。
ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートＡ") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAソースコード（一部）の翻訳
ソースコードの一部ですが、開発者が他界し訊けずにおります。 今後自分でもVBAを勉強しますが、お教えいただけますでしょうか。 なお冒頭は Function process_new(m0 As Integer, m As Integer, d As Variant, ans As Double) As Integer Dim a(501), b(501), s(501), r(501) As Double Dim w(501), g(11), xx As Double Dim s1 As Double Dim k(501) As Integer Dim i, j, flg As Integer でスタートしています。 ＝（以下、質問内容）＝＝＝＝ s1 = s(k(0)) * 1.618 flg = 0 For i = m0 To m - 3 If Not i = k(0) Then If s1 > s(i) Then flg = flg + 1 End If End If Next i ＝（以上）＝＝＝＝
- 締切済み
- オフィス系ソフト
- VBAでスロットを作る
VBAでゲームを作ろうとしています。まず、手始めに簡単なスロットを作っています。スロットを回転させて止めるまではできたのですがメッセージを出す段階でメッセージが2回、0とiの値が出ます。次のコードなのですが、なぜできないのか、どうすればできるようになるのか教えてください。よろしくお願いします。 Sub SlotLoop_1() Dim i As Long Static Flg As Boolean Flg = Not Flg 'ボタンを使えるようにする With [a1] 'Ａ１を選ぶ Do If Flg = False Then Exit Do i = (i + 1) Mod 10 '（i+1）を10で割った余り。 .Value = i DoEvents Loop End With MsgBox i 'ここが問題 End Sub
- ベストアンサー
- その他（プログラミング・開発）
- VBAのDoEventsが上手く動きません
お世話になります。 ExcelのVBAで印刷処理をしているのですが、印刷枚数が多いのでDoEventsイベントを入れ、印刷中断処理を行いたいのですが、上手くできません。 印刷中ダイアログが表示されるのが原因なのでしょうか？それともコードの書き方が悪いのでしょうか？よろしくお願いします。 コードは以下のとおりです。 ************************************************ Public Can_flg As Boolean ************************************************ Private Sub CommandButton1_Click() Can_flg = True End Sub ************************************************ Private Sub UserForm_Activate() Dim ms As String Dim j As integer Can_flg = False For j = 1 To 31 DoEvents If Can_flg = True Then ms = MsgBox("印刷を中止します。", vbOKCancel) If ms = vbOK Then Exit For Else Can_flg = False End If End If Me.Label1.Caption = "印刷中です… (" & j & "/" & i & "ページ)" Sheets("テスト").PrintOut Next j Unload Me End Sub
- ベストアンサー
- オフィス系ソフト
- vbaを使ってエクセルリストからPDFを印刷する
エクセルシートA列に"ファイル場所+ファイル名.pdf"を合体させたリストを作成しました。 リストの上から順にPDFファイルを開き印刷するコードを作成しました。 印刷はされますが、リストの順番に印刷されず、ものすごくランダムに印刷されてしまいます。 このエラーについて、 「次々に実行させるから、ファイルの容量順に印刷されてしまうのでは？ PDFを開いて、一旦閉じるコードを入れればよいのでは？」 というアドバイスをもらいましたが、どう対応したらよいか分かりません。 他に考えられる原因があるかもしれません。 教えて下さい。よろしくお願いします Dim i As Long 'セルC2に繰り返し数（ファイルの数）が入力されています For i = 1 To Range("C2").Value 'セルB**に印刷フラグを立て、「空欄」なら印刷、「1」なら印刷しないとしています '印刷フラグ「空欄」は印刷実行 If Cells(i + 1, 2).Value = "" Then PrinterName = Application.ActivePrinter fileName = Range("A" & i + 1).Value Set myShell = CreateObject("WScript.Shell") myShell.Run ("AcroRd32.exe /t " & fileName) '印刷フラグ「1」は印刷しない ElseIf Cells(i + 1, 2).Value = "1" Then End If Next i End Sub
- 締切済み
- Visual Basic
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel（エクセル）
- vba pdfファイル順番に印刷
セルC5から、下にファイル名が入っています。上から順に印刷したいのですが、下記だとvbaが動かないです。 Dim z As Object Dim i As Long Dim f, p As String Set z=CreateObject("WScript.Shell") p=Application.ActivePrinter For i=5 To Range("C1").End(xlDown).Row f="C:¥フォルダパス" & Cells(i,1).Value & ".pdf" ここから、行ごとに進んだ時に、黄色くならず反応しませんでした↓ If Dir (f)<>""Then z.Run("Acrobat.exe /t" & f) ↓ここにとびました。 Else End if Next i Set z=Nothing End Sub それ以前に、adobe acrobatが、更新されてから動いていたバッチファイルですら反応しなくなりました Adobeの環境設定をネットで見た通り見直ししたりしたのですが、全く成功しません。フォルダ内のpdfファイルを、全て印刷するvba（Acrobat.exe)を記載しない方法は成功したのですが、どうすれば、上手くいきますか？ 教えていただきたいです。印刷の順番を指定したいです。 初心者なのでお手柔らかにお願いします。ちなみに動いているほうのvbaは下記です。 フォルダ内のファイルを全て印刷する、（順番関係なし）です。 Dim FolderPath As String Dim Filename As String Dim objShell As Object Dim objFolder As Object Dim objFile As Object FolderPath=ThisWorkbook.Path Set objShell=CreateObject("Shell.Application") Set objFolder=objShell.Namespace(ThisWorkbook.Path) For Each objFile In objFolder.items If Right(objFile.Name,4)=".pdf"Then objFolder.ParseName(objFile.Name) .InvokeVerbEx("print") End If Next objFile Set objFile=Nothing Set objFolder=Nothing Set objShell=Nothing End Sub 上記は全てネットから引用しています。 adobe acrobatを使うと反応しないので下記、上記に付け足ししたりして自身で初めて考えました。 Sub Test() Dim FolderPath As String Dim Filename As String Dim objShell As Object Dim objFolder As Object Dim objFile As Object FolderPath=ThisWorkbook.Path Set objShell=CreateObject("Shell.Application") Set objFolder=objShell.Namespace(ThisWorkbook.Path) For i=5 To Range("C1")End(xlDown).Row ObjFile.Name=FolderPath&Cells(i,1).value&".pdf" If Dir objFile.Name<>""Then objFolder.ParseName(objFile.Name).InvokeverbEx("print") Else End if Next i Set objFile=Nothing Set objFolder=Nothing Set objShell=Nothing MsgBox"印刷が完了しました" End Sub どこか文書変でしょうか？？ 添削してくださいませんか。 順番に印刷、、できるとすごく仕事がはかどるため、成功させたいです。 お力添え、何卒お願いいたします。
- ベストアンサー
- Excel（エクセル）
補足
自分が行おうとしているのは、excel 2003での作業になります。 教えていただきましたリンク内のコードをマクロに記憶させて実行してみましたが’400’というエラーが出てしまいできませんでした。 >セルから読んだ名前に付け替えれば簡単かと思います。 Dim Fname As String Fname = WorkSheet("Sheet1").Range("A1").value などとすればいいのでしょうか。 FnameをPDFでの保存名にするには、どうすればいいでしょうか。 >保管場所も同様で、カレントディレクトリに出力されるのかどうか分かりませんが、目的の場所にコピーまたは移動してやればよろしいのではないでしょうか。 現場のオペレーターの方の作業を極力減らしたいので、マクロを走らせただけで、所定のサーバー内にPDF形式でexcelシートを保存したいと考えております。 できれば具体的なコードを示していただけると助かります。 初心者ですいません。宜しくお願い致します。