Excel VBA質問箱 IV

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

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


598 / 74625 ←次へ | 前へ→

【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

62 hits

【79668】作業数の追加と画像サイズのセル合わせ hitosi 18/3/2(金) 13:12 質問[未読]
【79670】Re:作業数の追加と画像サイズのセル合わせ γ 18/3/2(金) 21:59 回答[未読]
【79676】Re:作業数の追加と画像サイズのセル合わせ hitosi 18/3/3(土) 9:03 お礼[未読]

598 / 74625 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free