[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『PDFファイルのサイズ指定挿入』（挫折）
PDFファイルのサイズ指定挿入可能なのでしょうか？
過去ログをみても写真についてはのっていましたがＰＤＦが無くて・・・
マクロは分からないので、過去ログに テキストボックス→色と線→塗りつぶし効果
を試しましたが、ＰＤＦはダメなようで。
ちなみにＰＤＦはＡ4印刷で 2個～5個挿入して印刷したいです。
設定があるならシートを2個用・3個用と分けてもいいのですが。
会社で使用します、すでにＰＤＦファイルが数千点あるため
ＰＤＦでの挿入が希望です。 Excel2003を使用しています。
お願いします。
予め挿入したい位置に、枠を用意しておいて、pdfを挿入するマクロです。
１）PDFを挿入する位置にオートシェイプ（四角形）を用意してください ２）オートシェイプの書式設定で、「オブジェクトを印刷する」のチェックをはずします。 ３）右クリックして、下記のマクロを登録します。
４）オートシェイプをクリックしてマクロを実行します。 ５）選択したpdfファイルが挿入されます。
これを２個用シートには、２個用意しておきます。３個用シートなら３個です。
Sub pdfファイル挿入()
Dim myT As Double
Dim myL As Double
Dim myW As Double
Dim myH As Double
Dim myPDF
myPDF = Application.GetOpenFilename("pdfファイル,*.pdf")
If myPDF = False Then Exit Sub
With ActiveSheet.Shapes(Application.Caller)
myT = .Top
myL = .Left
myW = .Width
myH = .Height
End With
With ActiveSheet.OLEObjects.Add(Filename:=myPDF).ShapeRange
.LockAspectRatio = msoTrue
.Top = myT
.Left = myL
If myW / .Width > myH / .Height Then
.Height = myH
Else
.Width = myW
End If
End With
End Sub
マクロは使った事ないですが、今から挑戦してみます。
ここからは贅沢な相談です。
これでも十分なので無理ならあきらめます。
ＰＤＦファイルは全て横向きです。
Ａ4縦に3枚挿入する場合、上のほうに1枚、下に2枚並べて挿入します。
この時、少しでも大きくしたいので、下に並べるＰＤＦを90度回転した
状態で挿入できないでしょうか。
前にも書きましたが、既にＰＤＦファイルが数千あるため元データを
変更するのは大変で、ＰＤＦを回転して保存は不可能なようなので・・・
宜しくお願いします。
横用の枠には、こっちのマクロを登録してみてください。
Sub pdf横にして挿入()
Dim myT As Single
Dim myL As Single
Dim myW As Single
Dim myH As Single
Dim myPDF
myPDF = Application.GetOpenFilename("pdfファイル,*.pdf")
If myPDF = False Then Exit Sub
With ActiveSheet.Shapes(Application.Caller)
myT = .Top
myL = .Left
myW = .Width
myH = .Height
End With
Application.ScreenUpdating = False
ActiveSheet.OLEObjects.Add(Filename:=myPDF).Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
Selection.ShapeRange.Rotation = -90
Selection.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
'
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Top = myT
.Left = myL
If myW / .Width > myH / .Height Then
.Height = myH
Else
.Width = myW
End If
End With
Application.ScreenUpdating = True
End Sub
贅沢な悩みまで解決してもらい助かりました。
ありがとうございます。
もう1つ質問させてください。
現在、上の2つのマクロを利用させてもらっています。
オートシェイプをクリックすると「ファイルを開く」画面が出てきて
挿入するPDFファイルを選択するのですが、
この時「ファイルを開く」の画面は、たぶん最後に利用した場所が
出てくると思うのですが、場所を指定することは可能なのでしょうか？
（ファイルの保存先が大きく分けて2つあります。
例えば 3つのPDFを挿入する場合、1つはフォルダA 残り2つはフォルダB、とフォルダは固定です。
毎回、フォルダを移動する事は可能なのですが、会社で他の人も利用させてもらっているため
年配の方は場所が分からんといってきます。）
ディスクトップにショートカットを2つ作成するのも1つの方法なのですが、
部署や営業所が違ったりして説明が難しそうなので。
一応、過去の質問で、マクロ フォルダを開く 等で検索してみたのですが、分かりませんでした。
あるいは「場所を選ぶのが面倒」って感じるかも知れません。 最初に開くフォルダを指定することは可能なのですが、どういった運用がよいかは迷っています。
１）フォルダAかフォルダBどっちを選ぶかは、挿入する場所で決まっていますか。もしそうなら、今は縦用と横用を別のマクロにしていますが、そこは一つにして、ファルダA用、ファルダB用マクロにします。 ２）フォルダの場所は、部署や営業所ごとに違いますか。ネットワーク上の共有フォルダですか。
http://officetanaka.net/excel/vba/file/file02.htm
フォルダはネットワーク上の共有フォルダです。
挿入する場所とフォルダは決まっているので一度指定できたら、変わる事はありません。
今、参考に乗せてもらった所のネットワークドライブにChDriveするを見ています。
APIを使うやり方
Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
Sub Sample1()
SetCurrentDirectory "\\NotePC\E\Work\"
MsgBox CurDir
End Sub
"\\NotePC\E\Work\" ←ここのアドレスを変更すればいいと思うのですが
前に回答をいただいたマクロのどこに入れればいいのでしょうか？
別のマクロを設定するのでしょうか？
Sub Sample1()はSub pdf横にして挿入()と変更でいいのでしょうか？
質問ばかりでスイマセン。
１）各オートシェイプに、最初に開くフォルダを登録しておく。 右クリックから登録できるようにする。初回に登録すれば、2回目からはこの操作は不要です。 後で、フォルダを変更したくなれば再登録もできます。 この操作は、ひな形ファイルの作成者として、挫折さんが実行してください。 ２）オートシェイプを左クリックで、1）で登録されたフォルダが開き、PDFファイルを選択すると、挿入される。 この操作は、これまでと一緒です。 挫折さんが1）を実施しておけば、他の方は2）のみで済みます。 絶対に変更がないなら、コードの中に、フォルダの場所を書いてしまってもよいのですが その場合ですと、コードの意味がわかっていないと修正できないことになります。 正直なところ、どうしたほうがよいか迷っています。 いずれにしても、今は時間がないので、コードは今晩になります。
★の行は修正が必要です。ここでどのフォルダを開くかを決めています。
Sub フォルダAのPDF挿入()
Dim myT As Single
Dim myL As Single
Dim myW As Single
Dim myH As Single
Dim myPDF As String
myPDF = "\\NotePC\E\Work\" '★実際のフォルダAのパスに修正
With ActiveSheet.Shapes(Application.Caller)
myT = .Top
myL = .Left
myW = .Width
myH = .Height
End With
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "ファイルを選択して下さい"
.Filters.Clear
.Filters.Add "PDFファイル", "*.pdf"
.InitialFileName = myPDF
.Show
If .SelectedItems.Count > 0 Then
myPDF = .SelectedItems.Item(1)
Else
MsgBox "ファイルを選んで下さい"
End
End If
End With
Application.ScreenUpdating = False
ActiveSheet.OLEObjects.Add(Filename:=myPDF).Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
With Selection
If (myW - myH) * (.Width - .Height) < 0 Then
.ShapeRange.Rotation = -90
.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
End If
End With
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Top = myT
.Left = myL
If myW / .Width > myH / .Height Then
.Height = myH
Else
.Width = myW
End If
End With
Application.ScreenUpdating = True
End Sub
ハイパーリンクの使い方を初めて知りました。
こちらの方法で問題ないと思います。
ちなみに、マクロを教えてもらいましたが、コンパイルエラー・構文エラーが
でてきてしまいました。
色が反転するのは最初の Sub ﾌｫﾙﾀﾞAのPDF挿入()
ﾌｫﾙﾀﾞ名が問題あるのかと思い、漢字、カナ半角、半角英数など名前を変えてみたのですが
エラーは無くなりませんでした。名前の問題ではないのですね。
今後のために、このエラーが出てきた理由が分かると嬉しいです。
ﾌｫﾙﾀﾞ名は練習として「ﾌｫﾙﾀﾞA」とし、アドレスも
"\\NotePC\E\Work\"の NotePC\E\Work 部分を消して、「ﾌｫﾙﾀﾞA」の出てくる1つ前のアドレスを
（ﾌｫﾙﾀﾞの上に出てくるアドレス）コピーして貼り付けています。
明日で仕事納めです。
問題も解決し、来年より効率よく仕事が出来ます。
マナさんをはじめ、このサイトで助けてくれる方たち今年一年ありがとうございました。
来年も多く質問させてもらう事になると思いますが、宜しくお願いします。
よいお年をお過ごしください
ﾌｫﾙﾀﾞが開いて喜んでいたら、普通に開いただけで、エクセルに挿入されなかった・・・orz
オートシェイプ 右クリック ハイパーリンク で登録しましたが
マナさんの言う登録と違うのでしょうか？
年末の挨拶をした後で恥ずかしいのですが教えてください。
「ファイルを開く」画面のツール マイプレースで解決できました。
今度こそ・・・
よいお年をお過ごしください
上の提案は、ハイパーリンクではなく、
> １）各オートシェイプに、最初に開くフォルダを登録しておく。
は、この操作自体もマクロで実施することを考えていました。 ただし、この操作でも、１回だけフォルダAを探さないといけませんので「場所が分からん」となります。 それで、他の方ではなく、挫折さんに実施してもらうのが良いかなと考えたわけです。
Sub フォルダAのPDF挿入()のコンパイルエラーの件は、ちょっとわかりませんが、 マクロをコピペした画面で、 「ツール」ー「参照設定」を選び「Microsoft Office 11.0 Object Library 」 にチェックが入ってなければチェックしてみてください。
ともあれ、マイプレースで、解決したのであればよかったです。 ただ、デスクトップにショートカットと基本的に同じで、部署や営業所が違うと説明が大変ではありませんか。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.