Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
585 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【79668】作業数の追加と画像サイズのセル合わせ hitosi 18/3/2(金) 13:12 質問[未読]
【79670】Re:作業数の追加と画像サイズのセル合わせ γ 18/3/2(金) 21:59 回答[未読]
【79676】Re:作業数の追加と画像サイズのセル合わせ hitosi 18/3/3(土) 9:03 お礼[未読]
【79668】作業数の追加と画像サイズのセル合わせ
質問  hitosi E-MAIL  - 18/3/2(金) 13:12 -
引用なし
パスワード
   エクセル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
【79670】Re:作業数の追加と画像サイズのセル合わせ
回答  γ  - 18/3/2(金) 21:59 -
引用なし
パスワード
   1．については、セルのtop,Left,Width,Heightを元に画像のそれを調整。

2．については、、

　　プロシージャの頭で念のため以下を追加。
　　If Target.Count > 1 Then Exit Sub

　　配列を定義したあとで、例えば
　　Dim m As Variant
　　Dim adr As String
　　
　　adr = Target.Address(False, False)
　　m = Application.Match(adr, 型式, 0)
　　If IsError(m) Then Exit Sub　　　　 '該当セル以外を変更
　　などとして、何番目の要素であるか(index)を m とし、
　　既存の処理を、型式(m) 型式出力先(m) などに変更すればよいのでは？
【79676】Re:作業数の追加と画像サイズのセル合わせ
お礼  hitosi  - 18/3/3(土) 9:03 -
引用なし
パスワード
   返信ありがとうございます。

少しづつ理解して、仕上げていこうと思います。

ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
585 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free