Excelで棚割表を作っています。商品コードを打つとその商品の画像を自動で表示させたいのですが、雑誌を見ながらコードをアレンジしてほぼ完成したのですが、「プロシージャーが大きい」とエラーが出てマクロを実行出来ません。
画像は100個程度あり、先に別のマクロで貼り付けてあります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ファイル As String
If Intersect(Target, Range("A4")) Is Nothing Then
ActiveSheet.Shapes("画像").Delete
ファイル = "C:\保存場所\" & Range("A4").Value & ".jpg"
Range("B5").Select
ActiveSheet.Pictures.Insert(ファイル).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Top = ActiveCell.Top
Selection.ShapeRange.Left = ActiveCell.Left
Selection.ShapeRange.Height = 97
Selection.ShapeRange.Width = 52.5
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 1.5
Selection.ShapeRange.IncrementTop 1.5
Selection.Name = "画像"
End If
(中略)
Dim ファイル98 As String
If Intersect(Target, Range("U60")) Is Nothing Then Exit Sub
ActiveSheet.Shapes("画像98").Delete
ファイル98 = "C:\保存場所\" & Range("U60").Value & ".jpg"
Range("V61").Select
ActiveSheet.Pictures.Insert(ファイル98).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Top = ActiveCell.Top
Selection.ShapeRange.Left = ActiveCell.Left
Selection.ShapeRange.Height = 97
Selection.ShapeRange.Width = 52.5
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.IncrementLeft 1.5
Selection.ShapeRange.IncrementTop 1.5
Selection.Name = "画像98"
End Sub
省ける箇所や分割する方法などありましたら教えてください。
No.2ベストアンサー
- 回答日時:
#01です。
先のマクロでは商品コードをDeleteしたときに画像が残ってしまいますね。以下に差し替えます。Private Sub Worksheet_Change(ByVal Target As Range)
Dim ファイル As String
Dim nmPic As String
Dim res As Range
Set res = Sheets("対応表").colomns(1).Find(Target.Address(False, False), _
LookIn:=xlValues, lookat:=xlWhole)
If res Is Nothing Then
Exit Sub
Else
On Error Resume Next
nmPic = res.Offset(0, 1).Value '対応表のB列の値を格納
ActiveSheet.Shapes(nmPic).Delete
If Target.Value <> "" Then
ファイル = "C:\保存場所\" & Target.Value & ".jpg"
Target.Offset(1, 1).Select
ActiveSheet.Pictures.Insert(ファイル).Select
Selection.Name = nmPic
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Height = 97
.Width = 52.5
.Rotation = 0#
.IncrementLeft 1.5
.IncrementTop 1.5
End With
End If
End If
End Sub
早々の回答ありがとうございました。
さっそく対応表を作り、コードをコピーしましたが下記部分でエラーがでました。
Set res = Sheets("対応表").colomns(1).Find(Target.Address(False, False), _
LookIn:=xlValues, lookat:=xlWhole)
しかしながら、「.colomns(1)」を「.columns(1)」にする事で無事解決しました。
少ない説明で完璧な回答ありがとうございました。
No.1
- 回答日時:
対応表というシートを作成し、A列に商品コードが入力されるセルアドレスを列記しておきます。
B列はそのセルの右下セルに挿入する画像の名前ですA列 B列
A4 画像1
A8 画像2
A12 画像3
~中略~
U60 画像98
そうすれば以下のマクロだけで済むと思います。
商品コードが入力されたセルアドレスで対応表を検索し、合致するセルアドレスがあれば画像挿入の処理をするようにしています。
(テストはしていません。あしからず)
なお「On Error Resume Next」を追加したのは商品コードに対応する画像がシートにないときエラーとなるのを防止するためです。
オリジナルのロジックでは「最初から画像1~画像98が全てシート上にある」ときはエラーになりませんが、空いている表示欄に商品コードを入力すると削除しようとする画像がないのでエラーになりそうです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ファイル As String
Dim res As Range
If Target.Value = "" Then Exit Sub
Set res = Sheets("対応表").colomns(1).Find(Target.Address(False, False), _
LookIn:=xlValues, lookat:=xlWhole)
If res Is Nothing Then
Exit Sub
Else
On Error Resume Next
ActiveSheet.Shapes(res.Offset(0, 1).Value).Delete
ファイル = "C:\保存場所\" & Target.Value & ".jpg"
Target.Offset(1, 1).Select
ActiveSheet.Pictures.Insert(ファイル).Select
Selection.Name = res.Offset(0, 1).Value
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Height = 97
.Width = 52.5
.Rotation = 0#
.IncrementLeft 1.5
.IncrementTop 1.5
End With
End If
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Visual Basic(VBA) VBAの繰り返し処理について教えてください。 3 2022/08/02 13:21
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
「デスクトップの背景として設...
-
エクセル関数で画像を呼び出す...
-
未成年の入れ墨
-
自分、年が16何ですが刺青い...
-
「amazon」とはどんなロゴで書...
-
I love NY ロゴのフォント
-
和彫り
-
デザイン考
-
篆刻の、持ち手のデザインをウ...
-
クロスステッチ図案中のイニシ...
-
刺青にある彫り師の名前
-
Excel デザインモードが起動し...
-
ドレスデザイン評価お願いしま...
-
University RomanとGaramondと...
-
地下鉄の入り口のマークについて
-
よく怖そうなオジサンやおにい...
-
日本語フォントのサンプル表記(...
-
体に彫ってもらう事はいいです...
-
Webデザインの勉強の仕方
-
警察官
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル関数で画像を呼び出す...
-
エクセルに貼った画像の自動更新
-
画像一括ダウンロード
-
「デスクトップの背景として設...
-
右クリックで画像を保存しよう...
-
mp3のジャケット画像の消去
-
特定のtiff画像だけが真っ黒に...
-
BlueStacksを使っている方に質...
-
Google画像が開けない
-
パソコンでTwitterの画像を名前...
-
IEのWebアーカイブ形式のファイ...
-
ペイントから切り抜いた画像を...
-
mp3ファイルを、背景に画像をつ...
-
windows2000でUSBを認識しない...
-
画像の種類「MHTML]を「JPEG]に...
-
右クリックで保存できないHP...
-
Windows 10用の画像整理、仕分...
-
PowerPoint 2007で元画像の画質...
-
VBAで画像を自動で切り替える方法
-
今のDIORショッパーのデザイン...
おすすめ情報