エクセルVBAに詳しい方! マクロの解説お願いします!
- エクセルのファイルを開き、そのファイルに貼り付けてある図をすべてjpgに変換するマクロです。
- 特に[] は検索しても意味が分かりませんでした。一体、どういう意味なんでしょうか？
- 該当箇所は実行時エラーが発生した場合に、e1というラベル行（e1:）にジャンプし、エラーメッセージを表示する処理です。
- ベストアンサー
エクセルVBAに詳しい方! マクロの解説お願いします!
エクセルVBAに詳しい方! マクロの解説お願いします! 以下のマクロについて、どういう動作を行っているかわかるように 1行ずつコメントを打って頂けないでしょうか？ エクセルのファイルを開き、 そのファイルに貼り付けてある図をすべてjpgに変換するマクロです。 (ネットで公開されていたのですが、どういう動作をしているか分かりませんでした) 特に[] は検索しても意味が分かりませんでした。 一体、どういう意味なんでしょうか？ Sub test() On Error GoTo e1 'ダイアログを出してファイルを開く fn = Application.GetOpenFilename("Microsoft Excelブック (*.xls),*.xls", , "対象のファイルを開いてください") '画面の描画をOFFに Application.ScreenUpdating = False If fn <> False Then p = [B3] o = [B2] Select Case [C2] Case 1: pic = "図 (JPEG)" Case 2: pic = "図 (GIF)" Case 3: pic = "図 (PNG)" Case 4: pic = "図 (拡張メタファイル)" End Select Workbooks.Open Filename:=fn For Each ws In ActiveWorkbook.Sheets Sheets(ws.Name).Select For Each ss In ActiveSheet.Shapes If (ss.Name Like "Picture*" And p = True) _ Or (ss.Name Like "Object*" And o = True) Then ss.Select x = Selection.ShapeRange.Left y = Selection.ShapeRange.Top Selection.ShapeRange.Line.Visible = msoFalse Selection.Cut ActiveSheet.PasteSpecial Format:=pic Selection.ShapeRange.Left = x + 10 Selection.ShapeRange.Top = y + 10 End If Next Next ff = Mid(fn, InStrRev(fn, "\") + 1) ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls" fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls" ActiveWorkbook.SaveAs Filename:=fnd Windows(ff).Close 'メッセージBOXを出してどれだけファイルサイズが小さくなったか比較 MsgBox "前" & Format(FileLen(fn), "#,###バイト") & Chr(13) _ & "後" & Format(FileLen(fnd), "#,###バイト") & Chr(13) _ & "圧縮率" & Format(FileLen(fnd) / FileLen(fn), "0.0%"), , "終了" End If Application.ScreenUpdating = True e1: MsgBox "エラーが発生しました" End Sub
- ponta1_area
- お礼率40% (2/5)
- オフィス系ソフト
- 回答数5
- ありがとう数12
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
ご質問のようなコードは、私にはさっぱりわかりませんね。だいたい、そのコードは思ったように動くのでしょうか？データ型の宣言もないし、Shapeを.Nameで、取るなんて、ある程度の経験者なら、そのようなことはしません。 そもそも、 >そのファイルに貼り付けてある図をすべてjpgに変換するマクロです。 何かの間違いではありませんか？単に、貼り付けた画像を、xlsファイルに分配するだけだと思います。 基本的には、Chartオブジェクトか、HTMLに保存して、そこから取り出すという方法だけだったと思います。不勉強のため、他にあるのかは知りません。 > If (ss.Name Like "Picture*" And p = True) _ > Or (ss.Name Like "Object*" And o = True) Then これってなんでしょうね。そもそも、p, o の条件もわかりません。 それに、名前で取るというのはかなりヘンです。 >ss.Select >x = Selection.ShapeRange.Left >y = Selection.ShapeRange.Top そもそも、Select する必要もありませんね。 If ss.Type = msoPicture Then With ss X = .Left Y = .Top End With End If こうすれば良いです。 >On Error GoTo e1 >e1: としたら、必ず、エラーが発生するというメッセージが出ます。el:の前に、Exit Sub が抜けています。 o = [B2] >特に[] は検索しても意味が分かりませんでした。 そんな方法を覚えなくてもよいと思います。その中の引数は、ループカウンタを使えるわけではないし、通常使いません。
その他の回答 (4)
- keithin
- ベストアンサー率66% (5278/7940)
>ずらした位置に移動する意味はあるのでしょうか？ そのマクロを書いた人が，動かした方がいいと感じたのでそういうマクロにしたのでしょうね。 ホントの所何を考えてそうしたのかはマクロを書いた人に聞いてみるしかありませんが，あえて勝手に勝手に想像するなら，ぴくっとかずるっとか動くと，何か「した」のが判ってイイと思ったのかもしれませんね？？ 動かしては困るのでしたら勿論そういう判断が大切ですから動かさないマクロにすればいいですし，逆にもっと「ここに動かしたい」のでしたら，そのようなマクロに直してご利用いただくと良いと思います。
補足
動かしたと分かるようにですか。 ただ、あまり意味がないようなので、消しておきたいと思います。 ありがとうございました。
- keithin
- ベストアンサー率66% (5278/7940)
ん？ 一行一行の解説なんかホントは要らなくて，[]の説明だけ聞ければ満足だったのでしょうか？ 一応コメントの中にも勿論説明は入れておきましたが，エクセルのヘルプでも見たいのでしたら（とりあえず2002以降の場合） 「ショートカットを使ってセルを参照する」 というトピックスに説明があります。見つけられなければ,「ショートカット」でヘルプの検索を使ってみると有ります。 まぁたまに質問相談掲示板の回答とかで使って回答されるのを見かける事もありますが，基本的にほとんどの人はそういうマクロは書かずに普通にrangeとかcellsを使います。よっぽど「タイピング数を減らすことに絶対的に命をかけてます」みたいな無意味なこだわりの人ぐらいじゃないでしょうか。 いや判って使う分には，例えばイミディエイトウィンドウでさくっと使ってみるなんかで若干便利な場合もありますけどね。
補足
いえ、コメントが一番重要です。 すごく助かりました。ありがとうございます。 どういう動作をしているかようやく理解ができました。 すみません、それで、ついでの質問で申し訳ないのですが、 '１０ずつずらした位置に移動する Selection.ShapeRange.Left = x + 10 Selection.ShapeRange.Top = y + 10 なぜ、これを行うのか理解できなかったのですが、 ずらした位置に移動する意味はあるのでしょうか？ また、なぜ10移動させているのでしょうか？ もしよろしければ回答お願いします。
- hallo-2007
- ベストアンサー率41% (888/2115)
>特に[] は検索しても意味が分かりませんでした。 とは p = [B3] o = [B2] Select Case [C2] このことですよね。本当にこの様な記述の仕方は見慣れませんですね。調べてみても http://officetanaka.net/excel/vba/speed/s10.htm これぐらいしか見当たりませんでした。 [B3] は Rnage("B3") と置き換えておいて方が自分のためでもあり、今後他の人へ引継ぎとか考えると周りの人のためでもあると思います。 p oの変数の指定の部分が別のところにあると思い、あすが、表記のコードでは、変数の使用も1回しかありませんので If (ss.Name Like "Picture*" And Rnage("B3") = True) Or (ss.Name Like "Object*" And Rnage("B2") = True) Then でも作動しそうな気がします。 ss.Select x = Selection.ShapeRange.Left y = Selection.ShapeRange.Top Selection.ShapeRange.Line.Visible = msoFalse Selection.Cut ActiveSheet.PasteSpecial Format:=pic Selection.ShapeRange.Left = x + 10 Selection.ShapeRange.Top = y + 10 も ss.Select Selection.ShapeRange.Line.Visible = msoFalse Selection.Cut ActiveSheet.PasteSpecial Format:=pic Selection.ShapeRange.Left = Selection.ShapeRange.Left + 10 Selection.ShapeRange.Top = Selection.ShapeRange.Top+ 10 全体が見えているわけではないので、別名で保存するなどバックアップして、自分なりにわかりやすいコードに編集してみてください。 以下は、エラー処理についてのサイトです。 http://excelvba.pc-users.net/fol6/6_8.html ff = Mid(fn, InStrRev(fn, "\") + 1) ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls" fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls" も、もう少し整理できそうですが、InStrRev関数については http://officetanaka.net/excel/vba/function/InStrRev.htm などを参考にしてください。
お礼
ご回答ありがとうございました。 分かりやすい解説と参考ＵＲＬで大変勉強になりました。
補足
分かりやすい解説ありがとうございます。 []はセルを指していたわけですか……。 oとpの変数の指定部分ですが、どうも見当たらないです。 ttp://www.geocities.co.jp/SiliconValley-Sunnyvale/9554/ このマクロはこちらのサイトで公開されているものなのですが、 見えないようにしてあるのでしょうか……。
- keithin
- ベストアンサー率66% (5278/7940)
>1行ずつコメントを打って頂けないでしょうか？ それは人にやって貰うんじゃなくマクロの判らない単語でF1キーを押し，ヘルプで各命令が実際どんな風に使われているか（間違っているか）調べるモノです。 Sub test() '実行時トラップできるエラーが発生したらラベルe1に移動する On Error GoTo e1 '開きたいファイル名をfnに格納する fn = Application.GetOpenFilename("Microsoft Excelブック (*.xls),*.xls", , "対象のファイルを開いてください") '画面更新を抑制する Application.ScreenUpdating = False 'ファイルを開くダイアログでキャンセルを押しファイルを指定しなかったのではなかった場合（１） If fn <> False Then 'ｐとｏにアクティブシートのb3とb2セルの値を格納 p = [B3] o = [B2] 'c2セルの値に応じてc2が１２３４だったときはpictにあれこれを格納 Select Case [C2] Case 1: pic = "図 (JPEG)" Case 2: pic = "図 (GIF)" Case 3: pic = "図 (PNG)" Case 4: pic = "図 (拡張メタファイル)" End Select ’fnのファイル名のファイルを開く Workbooks.Open Filename:=fn 'アクティブブックのシートの全てについて巡回を開始する（２） For Each ws In ActiveWorkbook.Sheets ’（２）をアクティブシートにする Sheets(ws.Name).Select ’アクティブシート上の図形について巡回を開始する（３） For Each ss In ActiveSheet.Shapes ’（３）の図形の名前がPicture何タラでかつpがTrueであるか，又は，図形名がObjectなんたらであってoがTrueであれば（４） If (ss.Name Like "Picture*" And p = True) _ Or (ss.Name Like "Object*" And o = True) Then ’図形を選択し ss.Select ’ｘとｙに選択図形のLeftとTopを格納し x = Selection.ShapeRange.Left y = Selection.ShapeRange.Top ’選択図形の外線を無しにして Selection.ShapeRange.Line.Visible = msoFalse ’選択図形を切り取り Selection.Cut ’切り取った図形をpictのフォーマットで貼り直す ActiveSheet.PasteSpecial Format:=pic ’今選ばれてるもののを１０ずつずらした位置に移動する Selection.ShapeRange.Left = x + 10 Selection.ShapeRange.Top = y + 10 ’（４）の動作はここまで End If ’（３）について繰り返す Next ’（２）について繰り返す Next ’fnからffとfndを加工する ff = Mid(fn, InStrRev(fn, "\") + 1) ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls" fnd = Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls" 'アクティブブックをファイル名をfndで保存する ActiveWorkbook.SaveAs Filename:=fnd ’ffを閉じる Windows(ff).Close 'メッセージBOXを出して各ファイルの大きさと比率を計算して表示する MsgBox "前" & Format(FileLen(fn), "#,###バイト") & Chr(13) _ & "後" & Format(FileLen(fnd), "#,###バイト") & Chr(13) _ & "圧縮率" & Format(FileLen(fnd) / FileLen(fn), "0.0%"), , "終了" ’（１）の終わり End If ’画像の更新抑制を解除 Application.ScreenUpdating = True ’この部分でよくある間違いを犯している ’エラーセクションの開始 e1: ’メッセージボックスを表示する MsgBox "エラーが発生しました" End Sub
お礼
すみません、keithinさんが回答していただいたのを ベストアンサーに選ぼうとして間違えてしまいました。 非常に助かりました、ありがとうございます。
補足
ご回答ありがとうございます。 F1でヘルプが見られるんですね。 しかし、[]についてはF1を押しても分かりませんでした。
関連するQ&A
- エクセル2007のマクロで画像挿入がうまくいきません。
エクセル2007のマクロで画像挿入がうまくいきません。 写真のサイズ縦横比がセルにあっていないので伸びてしまいます。 下記のプログラムでサイズ変更も可能でしょうか？ フォームのボタンの上に張り付けた場合、ボタンを隠す事は 出来ますか？ ボタンの色は変更できるのでしょうか？ いろいろわがままな質問で申し訳ありません。 マクロ初心者です。 Sub Pic_in2007() fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = range("B5:C6").height Selection.ShapeRange.Width = range("B5:C6").width Selection.ShapeRange.left = range("B5:C6").left Selection.ShapeRange.top = range("B5:C6").top End Sub
- ベストアンサー
- オフィス系ソフト
- Excelマクロのオフセットについて
マクロのセルのオフセットについて質問です。 複数の画像（仮に7枚）を一度に張り付ける際に If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If このようなマクロ組むと 1 2 3 4 5 6 7 という感じになります。 列は8列空いて、行は4行空くことになると思うのですが これを 1 2 3 4 5 6 7 としたい場合はどのようなマクロの書き方をすればよいのでしょうか？ ご指導の程宜しくお願いします。マクロを張り付けておきます。 Declare Function SetCurrentDirectory Lib "kernel32" Alias _ "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long Sub 画像一括貼り付け() Dim Fname As Variant, fe As Variant Dim Fn As Variant, Pic As Shape Dim pno As Long Dim myFileName As String Range("A8").Select SetCurrentDirectory "P:\投レ＋相模原\F-POT KBB42365\外観確認" Fname = Application.GetOpenFilename _ ("jpg,*.jpg,jpeg,*.jpeg,bmp,*.bmp,gif,*.gif,png,*.png", MultiSelect:=True) If Not IsArray(Fname) Then MsgBox "取り消されました。", vbInformation Exit Sub End If Application.ScreenUpdating = False pno = 0 For Each Fn In Fname 'この次へ追加すべき行 Selection.Offset(-1, 0) = Mid(Fn, InStrRev(Fn, "\") + 1, Len(Fn) - InStrRev(Fn, "\")) ActiveCell.Select Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=Fn, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=0, Top:=0, Width:=360, Height:=270) With Pic .ScaleWidth 1, msoTrue .ScaleHeight 1, msoTrue .Top = ActiveCell.Top ' 位置：アクティブセルの上側に重ねる .Left = ActiveCell.Left ' 位置：アクティブセルの左側に重ねる .Placement = xlMove ' 移動するがサイズ変更しない End With If ActiveCell.Column = 1 Then ActiveCell.Offset(, 8).Select Else ActiveCell.Offset(4, -8).Select End If Set Pic = Nothing pno = pno + 1 Next Application.ScreenUpdating = True Range("A1").Select MsgBox pno & "枚の画像を挿入しました", vbInformation End Sub
- ベストアンサー
- Excel（エクセル）
- Word2007マクロ
宜しくお願い致します Word2007でこんな事が出来ますか Excel2007で線路を作るマクロを作成しました(本を見て) これをWordでも使用したいのですが、Excelのマクロそのまま WordのVisual Basicに書き込んでもエラーが出て機能しません Excelのマクロは以下です Sub 線路作成() 上端位置 = Selection.Top 左端位置 = Selection.Left Selection.ShapeRange.Line.Weight = 6# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Duplicate.Select Selection.ShapeRange.IncrementLeft -18# Selection.ShapeRange.IncrementTop 9.6 Selection.ShapeRange.Line.DashStyle = msoLineDash Selection.ShapeRange.Line.Weight = 4.5 Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.ForeColor.SchemeColor = 9 Selection.ShapeRange.Line.Visible = msoTrue Selection.Top = 上端位置 Selection.Left = 左端位置 End Sub Wordで使えるようにするには、どこを直せばよいでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセル2007でマクロを使った写真挿入がうまくいきません。
エクセル2007でマクロを使った写真挿入がうまくいきません。 エクセル2003で使っていたひな形をもらったのですが2007では結合したセルから ずれてしまいます。 どうすれば位置の修正をできますか？ また、結合した大きなセルの中にフォームボタンを付けいるのですが 2003では写真が挿入されるとボタンは隠れてしまっていたのですが、 2007では挿入した写真に重ねって写真が見ずらいです。 隠すことはできるのでしょうか？ なにぶん初心者なのでお願いします。 Sub Pic_in() ' マクロ記録日 : 2003/7/1 kome fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 247.5 Selection.ShapeRange.Width = 350 End Sub
- ベストアンサー
- オフィス系ソフト
- Excel マクロのエラーを直したいです。
いつもお世話になっております。 さて、下記マクロを作成（コピー＆ペースト）したのですが、矢印以外のあみかけ、罫線などがセルに表示されてしまいます。 どのように修正すれば、矢印だけが表示されるようになるのでしょうか？ 修正頂ければ、幸甚です。宜しくお願い致します。 ※マクロ初心者です。 (1)Sub 外部デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF, TP, LF + WD, TP).Select Selection.ShapeRange.Line.Weight = 1# Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub (2)Sub 認知デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub
- ベストアンサー
- その他MS Office製品
- エクセルマクロでオブジェクトを選択する方法
エクセル（2002）を使っています。マクロの記録機能を使って円を描くマクロを作成しました。 Sub Maru(xpos, ypos, hankei) ActiveSheet.Shapes.AddShape(msoShapeOval, xpos, ypos, hankei, hankei).Select Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) End Sub 次にこの円を削除したいと思い、同じようにマクロの記録機能を使ったところ、 Sub Macro3() ActiveSheet.Shapes("Oval 64").Select Selection.Delete End Sub となりました。"Oval 64"はオブジェクトの名前のようですが、名前がわかっていないオブジェクト（但し上記マクロで書いたので場所はわかっている）を選択するにはどうしたらいいでしょうか。
- ベストアンサー
- Visual Basic
- Excel2007 VBAで画像挿入について
Sub 図形挿入等倍() Dim FilePath As Variant FilePath = Application.GetOpenFilename(",*.png") If Not FilePath = False Then ActiveSheet.Pictures.Insert(FilePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1# Selection.ShapeRange.Left = ActiveCell.Left + 2.25 Selection.ShapeRange.Top = ActiveCell.Top + 2.25 End If With Selection.ShapeRange.Line .Weight = 2.25 '線の太さを2.25に .ForeColor.RGB = RGB(255, 0, 0) '赤枠に End With End Sub 上記のコードを書き、画像を挿入したときは問題ないのですが 画像を挿入せずにキャンセルすると 実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。とでてしまいます デバックをしてみると With Selection.ShapeRange.Lineの部分が黄色くなっているので ここを修正したらいいと思うのですが どのように修正したらいいのか分かりません お分かりの方いましたらご教授お願い致します
- ベストアンサー
- その他MS Office製品
- エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、
エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、 分からない部分があって困ってます。 (1)挿入したいセルにカーソルを合わせる (2)マクロ 挿入－図－ファイル－図の挿入－図の書式設定－サイズ－30％ この作業を覚えさせると以下になりました。 Sub Macro3() ActiveSheet.Pictures.Insert("C:\Documents and Settings\デスクトップ\1.JPG") _ .Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 360# Selection.ShapeRange.Width = 480# Selection.ShapeRange.Rotation = 0# End Sub これだと、写真が指定されてしまいます。 マクロの途中で止まって任意の写真を都度選べるようにできますか？ 膨大な量の写真をセルに並べていきたいのです。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロ 画像を所定の位置に貼り付けるには？
エクセル上でボタンを押すと写真データーを所定の位置に貼り付ける 書式（excel2003で作成）を使っています。 exｃel2010になってから、皆さんが質問されているようにリンク張付になってしまい 保存していた書類から写真が消えてしまいました。 今は作成したらPDFで保存していますが、修正ができません。 そこで、ネットでいろいろ検索して、マクロをいじっているのですが、 コピー→削除→ペースト（セルの位置）まではなんとかできたのですが 指定した位置に貼り付ける方法が分かりません。 よろしくお願いします。 修正中のマクロが下記です。 Sub select_pic() Dim tt, ttl, Item As String Dim FileNamePath As Variant 'ファイルのパスを取得します tt = "写真 ファイル (*.jpg),*.jpg" ttl = "写真ファイルを選択してください" FileNamePath = SelectFileNamePath(tt, ttl) If FileNamePath = False Then 'キャンセルボタンが押された End End If ActiveSheet.Pictures.Insert(FileNamePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = 263 Selection.ShapeRange.Left = 12 Selection.ShapeRange.Top = 45 Selection.CopyPicture Selection.Delete ActiveSheet.Paste End Sub 最後のPasteの前後に座標を入れればいいのだと思いますが エラーが出てだめです。分かる人にとっては簡単なのでしょうが よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAでの画像ファイル名取得他
VBAについての質問です。 http://hp.vector.co.jp/authors/VA033788/kowaza.html#0158 上記をベースに、なんとかVBAを下記のように書き換えました。 Sub LoadPictures3() Dim Fnames As Variant Dim Fn As Variant Dim i As Integer Dim Pic As Picture Dim R As Range Dim R2 As Range Dim Pc As Integer Fnames = Application.GetOpenFilename("図(*.jpg;*.gif),*.jpg;*.gif", MultiSelect:=True) If TypeName(Fnames) = "Boolean" Then Exit Sub Application.ScreenUpdating = False '一枚目の貼付け位置 Set R = Range("B5") Set R2 = R.Offset(35) Pc = 0 For i = 1 To UBound(Fnames) Set Pic = ActiveSheet.Pictures.Insert(Fnames(i)) Select Case (i - 1) Mod 4 + 1 Case 1 Pc = Pc + 1 If Pc >= 2 Then ActiveSheet.HPageBreaks.Add R2 End If With R Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 2 With R.Offset(0, 6) '一枚目に対する二枚目の相対位置 Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 3 With R.Offset(18, 0) Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 4 With R.Offset(18, 6) Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With '次ページの相対位置 Set R = R.Offset(39) End Select Next Application.ScreenUpdating = True End Sub ここで、画像の上の位置（B5のセル位置の画像の場合、B4）に 元々の画像ファイル名を取得し、表記させたいのですが 調べた所、multiselect:=Trueで複数ファイルを選択するときに 画像名が図1、図2に変わっているようで、どうしていいかわかりません。 後、画像を300×225の「変倍」画像にしたいのですが どのようにすれば可能でしょうか？ 全くVBAの知識がなく、上のURLを参考に、単語を調べつつ書き換えている状態で、変数やらなんやらの指定・書き方等わかりません。 どなたかご教授願います。
- ベストアンサー
- オフィス系ソフト
補足
ご回答ありがとうございます。 一応、ちゃんと想定されているように動きはします。 ttp://www.geocities.co.jp/SiliconValley-Sunnyvale/9554/ こちらで公開されているマクロです。