[[20080209021147]] 『画像の貼り付け』(VBA初心者) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『画像の貼り付け』(VBA初心者)

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

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

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

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

宜しくお願い致します。


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

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

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

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

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

貼り付けるコードです。

尚、フォルダ、「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@犬とお散歩さん

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

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

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

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

(セルB2には、aaaと入力した時に、aaa.jpgの図を挿入したいのです。。。)

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

宜しくお願いします!!


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

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

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

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

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

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


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

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

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

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)

私は、ファイルI/Oに関するエラーチェックは、

ほとんど On error 〜 を

使っています。

今回のPictures.Insertでは、

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

ファイルI/Oの場合は、ファイルの有無以外にも

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

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

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 さん

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

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

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

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


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.