[[20080209021147]]　『画像の貼り付け』（VBA初心者）　ページの最後に飛ぶ

『画像の貼り付け』（VBA初心者）

初めて書き込みさせて頂きます。

コマンドボタンを押すことにより、"B2"の値と同じ名前の画像を"D5"に貼り付けたいのです。。。

ちなみに画像はC:\Documents and Settings\My Documents\My Picturesにjpegで保存されています。

どなたか教えて頂けないでしょうか？

宜しくお願い致します。

画像を挿入するのがこのセルＤ５だけ（あるいは、個数が限定されて少ない）なら、

イメージコントロール（コマンドバー　コントロールツールボックス）を配置して、

そこに画像を表示するという方法が簡単だと思います。

下記のコードは、セルＢ２に設定されているファイル名（例　aaa.jpg)

の画像をセルＤ５の大きさに合わせて

貼り付けるコードです。

尚、フォルダ、「C:\Documents and Settings\My Documents\My Pictures」

だとします。

'=======================================================================

Sub 図の挿入()

    Const foldnm = "C:\Documents and Settings\My Documents\My Pictures\"
    Dim org As Range
    Set org = Range("d5")
    On Error Resume Next
    With ActiveSheet.Pictures.Insert(foldnm & Range("b2").Value)
       .Left = org.Left
       .Top = org.Top
       .Width = org.Width
       .Height = org.Height
       End With
    On Error GoTo 0
End Sub

当該シートをアクティブにした状態で上記の「図の挿入」を

実行してみてください。

ichinose@犬とお散歩

ichinose@犬とお散歩さん

早々とお返事ありがとうございます。

私がイメージしてるもので、助かりました！！

申し訳ございませんが、もう２つ教えてください！！

①フォルダには"jpg"のものしか存在しないのですが、拡張子をセルＢ２に入れずにできますでしょうか？

（セルＢ２には、aaaと入力した時に、aaa.jpgの図を挿入したいのです。。。）

②もう１つは、図の大きさを指定したいのですが。。。

宜しくお願いします！！

 1の回答 ActiveSheet.Pictures.Insert(foldnm & Range("b2").Value) を
ActiveSheet.Pictures.Insert(foldnm & Range("b2").Value & ".jpg") に
 2の回答
 どの様な方法で指定するのか解らないので・・・？
(TT)

お返事ありがとうございました！！

今まで印刷していたものにのりで貼り付けていたので、これで大分楽になります！！

②の件なのですが、”画像をセルＤ５の大きさに合わせて ”とあるのですが、縦と横のサイズの指定はできますでしょうか？

今セルＤ５が小さいので、図がかなり小さいのです。。。

なんどもすみませんが、宜しくお願い致します！！

       .Width = org.Width 'これが画像の横幅
       .Height = org.Height 'これが高さです

今は、これらの大きさをセルＤ５の大きさに合わせていますから、

数字をいれるなり、又は、Ｄ５の大きさを変えるなり、工夫してください。

ichinose

ichinose　さん

早々お返事ありがとうございました！！

またまた質問なのですが、図がなかった時にエラーメッセージを表示したいのですが。。。

何処にどのように追加したらいいのか教えて頂けないでしょうか？

宜しくお願いします！！

 横から失礼します。
 Dir関数の戻り値で指定ファイルの有無をチェックできます。

http://www.konomiti.com/vba03_2.html

 FileSystemObjectを使ってもファイルの有無をチェックできます。
http://www.officetanaka.net/excel/vba/filesystemobject/filesystemobject.htm
 (MARBIN)

MARBIN さん　ありがとうございました！！

　　If Dir(foldnm & Range("b3").Value & ".jpg") = "" Then

       MsgBox "請求書.xls　がありません"

       Exit Sub
    End If

と、このようにはできたのですが、"b3"の内容をMsgBoxに表示させたいのですが。。。

教えてください！！

宜しくお願いします！

 MsgBoxで表示するものには変数も使えます。

 Dim hen As String
  hen = "変数"
  MsgBox hen

 もちろんセルの値も使えます。

 MsgBox Activesheet.Range("B3").Value

 あるいは、
 Dim r As Range
 Dim MsgStr As String
  Set r = Activesheet.Range("B3")
  MsgStr = r.Value
  MsgBox MsgStr
  'MsgBox r.Value

 ついでながら、MsgBox関連の解説です。参考になると思います。 
http://www.konomiti.com/vba01_5.html
 (MARBIN)

私は、ファイルＩ／Ｏに関するエラーチェックは、

ほとんど　On error ～　を

使っています。

今回のPictures.Insertでは、

エラーコードが曖昧ということもありますが（原因の特定ができない）、

ファイルＩ／Ｏの場合は、ファイルの有無以外にも

特定できないエラーもあるので・・・。

（例　シェアエラー（他のアプリで使用中でロック））

Sub 図の挿入()

    Const foldnm = "C:\Documents and Settings\My Documents\My Pictures\"
    Dim org As Range
    Set org = Range("d5")
    On Error Resume Next
    With ActiveSheet.Pictures.Insert(foldnm & Range("b2").Value & ".jpg")
       If Err.Number <> 0 Then
          MsgBox "画像挿入は、何らかの原因で失敗しました"
       Else
          .Left = org.Left
          .Top = org.Top
          .Width = org.Width
          .Height = org.Height
          End If
       End With
    On Error GoTo 0
End Sub

エラー原因の特定のために

エラー発生後にDIR関数で確認するのは良いと思いますが・・・。

いずれにせよ、On Error Resume Next　

でのトラップは付けておいた方が良いですよ！！

ichinose

MARBIN さん

ichinose　さん

お返事ありがとうございました！！

皆さんのおかげで、明日から仕事が楽になりそうです！！

本当にありがとうございました！！

また分からないことがあれば、宜しくおねがいします！！

コメント返信：

[ 一覧(最新更新順) ]

[[20080209021147]] 『画像の貼り付け』（VBA初心者） ページの最後に飛ぶ

[[20080209021147]]　『画像の貼り付け』（VBA初心者）　ページの最後に飛ぶ