FC2ブログ
エホバの証人二世の、個人研究&趣味blogです。
2019/06«│ 2019/07| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 »2019/08
文字色の変化のON/OFFが出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
16:46:37
PDFのリンクを作成し、リンクをクリックすると自動で印刷してくれます。
本当に楽しいマクロです。仕事で良く使えます。

Sub PDF印刷()
Dim x As Long
Dim namae
x = 1
For Each ws In Worksheets
If ws.Name = "PDF印刷" Then
ws.Delete
End If
Next
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = "PDF印刷"

Const cnsDIR = "\*.pdf"
Dim strFilename As String
Dim ken As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
ken = .SelectedItems(1)
End If
End With



Dim GYO As Long ' 先頭のファイル名の取得
strFilename = Dir(ken & cnsDIR, vbNormal)
' ファイルが見つからなくなるまで繰り返す
Do While strFilename <> ""
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:=ken & "\" & strFilename, SubAddress:="" _
, TextToDisplay:=strFilename
x = x + 1
strFilename = Dir()
Loop
With ActiveWorkbook.VBProject.VBComponents.Item(Worksheets("PDF印刷").CodeName).CodeModule
.InsertLines 1, "Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)"
.InsertLines 2, "Dim a As Variant"
.InsertLines 3, "Set w = CreateObject(" & """" & "WScript.Shell" & """" & ")"
.InsertLines 4, "w.Run (" & """" & "AcroRd32.exe /t " & """" & " & Chr(34) & ActiveCell.Hyperlinks(1).Address & Chr(34))"
.InsertLines 5, "Set w = Nothing"
.InsertLines 5, "End Sub"
End With
End Sub








ねこちゃん可愛いです。

コメント
コメントの投稿










トラックバック
トラックバックURL
→http://ayukt0526.blog.fc2.com/tb.php/451-e1c3393d
この記事にトラックバックする(FC2ブログユーザー)
プロフィール

はなかな

Author:はなかな
FC2ブログへようこそ!

最新記事
最新コメント
月別アーカイブ
カテゴリ
フリーエリア
ランキング参加しています。 にほんブログ村 哲学・思想ブログ エホバの証人へ にほんブログ村 にほんブログ村 本ブログ 読書日記へ にほんブログ村 にほんブログ村 音楽ブログへ にほんブログ村
音楽(J-POP) ブログランキングへ
小説(読書感想) ブログランキングへ
キリスト教 ブログランキングへ
ブログランキング ブログ王ランキングに参加中!
検索フォーム
RSSリンクの表示
リンク
このブログをリンクに追加する
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
FC2アフィリエイト