| |
エクセルVBE初心者です。
わからないことがあり困っている為、質問させて頂きます。
下記のプログラムは作成途中の物になります。
現状の状態だとC3のセルに入力した文字を、「画像フォルダ」というフォルダから検索して
.bmpファイルを、別のWorksheets("ｼﾞｬﾝﾙ名、種別")のC22のセルに、張り付ける
C3の入力に何もない、もしくはC3に入力した文字のファイルが「画像フォルダ」になければ
「指定したファイルがありません」とメッセージを出力するという状態までは出来ているのですが
そこからさらにもう少しアレンジを加えたく困っています。
内容としては2つあります。
1.張り付ける画像のサイズをセルのサイズと同じにする。（画像の比率はいじっても構わない）
2.入力先と貼り付け先を複数個作りたい
現状2.に関しては入力先とそれを出力する先は
頭で宣言しているのですが、現状の形からどのように変えていけばよいのか
わからない為、困っています。
どなたか分かる方がいれば、ご教授お願いします。
Private Sub Worksheet_Change(ByVal Target As Range) 'ﾜｰｸｼｰﾄ内の何処のセルを変更しても自動的に実行する。という意味
Dim 型式(1 To 18) As String '型式(1)〜型式(18)という代入先を作成
型式(1) = "C3" '代入先を使用するセルを指定
型式(2) = "C4" '代入先を使用するセルを指定
型式(3) = "C5" '代入先を使用するセルを指定
型式(4) = "C6" '代入先を使用するセルを指定
型式(5) = "C7" '代入先を使用するセルを指定
型式(6) = "C8" '代入先を使用するセルを指定
型式(7) = "C9" '代入先を使用するセルを指定
型式(8) = "C10" '代入先を使用するセルを指定
型式(9) = "C11" '代入先を使用するセルを指定
型式(10) = "C12" '代入先を使用するセルを指定
型式(11) = "C13" '代入先を使用するセルを指定
型式(12) = "C14" '代入先を使用するセルを指定
型式(13) = "C15" '代入先を使用するセルを指定
型式(14) = "C16" '代入先を使用するセルを指定
型式(15) = "C17" '代入先を使用するセルを指定
型式(16) = "C18" '代入先を使用するセルを指定
型式(17) = "C19" '代入先を使用するセルを指定
型式(18) = "C20" '代入先を使用するセルを指定
Dim 型式出力先(1 To 18) As String '型式出力先(1)〜型式出力先(8)という代入先を作成
型式出力先(1) = "C22" '画像挿入先のセル
型式出力先(2) = "AS22" '画像挿入先のセル
型式出力先(3) = "C81" '画像挿入先のセル
型式出力先(4) = "AS81" '画像挿入先のセル
型式出力先(5) = "C140" '画像挿入先のセル
型式出力先(6) = "AS140" '画像挿入先のセル
型式出力先(7) = "C199" '画像挿入先のセル
型式出力先(8) = "AS199" '画像挿入先のセル
型式出力先(9) = "C258" '画像挿入先のセル
型式出力先(10) = "AS258" '画像挿入先のセル
型式出力先(11) = "C317" '画像挿入先のセル
型式出力先(12) = "AS317" '画像挿入先のセル
型式出力先(13) = "CI22" '画像挿入先のセル
型式出力先(14) = "DY22" '画像挿入先のセル
型式出力先(15) = "CI81" '画像挿入先のセル
型式出力先(16) = "DY22" '画像挿入先のセル
型式出力先(17) = "CI140" '画像挿入先のセル
型式出力先(18) = "DY140" '画像挿入先のセル
Const path As String = "C:\画像フォルダ/" 'ファイルの格納フォルダ
Const pic As String = ".bmp" '「.(半角)」＋ファイルの拡張子"
Dim shp As Shape
Dim buf As String
If Target.Address(0, 0) = 型式(1) Then
For Each shp In Worksheets("ｼﾞｬﾝﾙ名、種別").Shapes '既に表示されている画像を削除する処理（Worksheet変更版）
If Not Intersect(Worksheets("ｼﾞｬﾝﾙ名、種別").Range(型式出力先(1)), Worksheets("ｼﾞｬﾝﾙ名、種別").Range(shp.TopLeftCell, _
shp.BottomRightCell)) Is Nothing Then '既に表示されている画像を削除する処理 （Worksheet変更版）
shp.Delete
End If
Next
Range(型式出力先(1)).Select
buf = Dir(path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
Worksheets("ｼﾞｬﾝﾙ名、種別").Pictures.Insert (path & Target.Value & pic)
Else
MsgBox "指定したファイルがありません"
End If
End If
Target.Offset(1, 0).Select
End Sub
|
|
hitosi
- 18/3/2(金) 13:12 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
