オートシェイプを使った画像の切り替え【ExcelVBA】

 ★ 落書き 動画 エクセルマクロ ★ 
ご訪問頂きありがとうございます。アラクリカエシキ(阿良々木)です。以前にもやったネタなんですが、使用した画像がエロかった?(ToLOVEるの模写)みたいでYouTubeさんから年齢制限がどーのと警告がきて(;^_^A動画削除してしまったので再アップです。
 INDIRECT関数を使った画像の切り替えはネットでもよく紹介されているのですが、画像の数が増えると面倒なので作った記憶があります。たしか仕事で商品画像つきのポップみたいなものを作るとき数が多かったので組みました。
「VLOOKUP 画像」で検索する人が多いらしいのですがVLOOKUPではできません。でも、今回のコードはVLOOKUPと併用して使用可能です。ぜひ試してみてください。
s-VLOOKP.jpg

※コードは追記欄に載せてます。
エクセルファイルと同じフォルダに「PIC」というフォルダを作りそのなかに画像ファイルを放り込んでおきます。(01.JPG~99.JPG)
シートでは、セルB1が検索値で、セルF1が開始番号セルH1が終了番号となっていてFor Nextで処理します。(今回の動画は8枚の落書きを表示させたのでセルF1が1セルH1が8です)




 ★ コマンドボタン (スタート)★ 

Option Explicit

Private Sub CB1_Click()
Dim bangou, a, n As Long
Dim picst As String
a = Range("F1").Value '開始番号
n = Range("H1").Value '終了番号
For bangou = a To n
 DoEvents
 Range("B1").Value = bangou
 Call AdPic        ’画像表示のマクロを呼び出す。
 DoEvents
 Application.Wait Now() + TimeValue("00:00:03")’表示間隔の設定
Next bangou
End Sub




 ★ 標準モジュール ★ 

Option Explicit

Sub AdPic()
Application.ScreenUpdating = False
Dim i As Long
If Worksheets(1).Shapes.Count = 0 Then
GoTo ADDPIC
Else
GoTo DELSHAP
End If
DELSHAP:
With Worksheets(1)
For i = .Shapes.Count To 1 Step -1
If .Shapes(i).Type = msoPicture Then .Shapes(i).Delete
Next i
End With
ADDPIC:
Dim picst As String
picst = ThisWorkbook.Path & "\PIC\" & _
Right("00" & Range("B1").Value, 2) & ".JPG"
If Dir(picst) = "" Then
MsgBox "ERROR"
Exit Sub
End If
Worksheets(1).Shapes.AddPicture _
Filename:=picst, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, _
Top:=32, _
Width:=640, _
Height:=360
Application.ScreenUpdating = True
End Sub

関連記事
スポンサーサイト



コメントの投稿

非公開コメント

動画も拝見しましたよー

動画も拝見しましたね
すばらしく上手に使っておりました☆彡

私は尊敬しますよ!!
ワードエクセルとか苦手なもので,,,(笑)

がちょーさま、またまた こんばんわv-10

動画は以前にも同じネタでアップしてたんですけど使用した画像がToLOVEるの模写で(モザイクか開けてたんですけど)エロいとYouTubeさんから警告が来て削除しましたよ^^

ワードは僕も苦手です(>_<)

僕はそれより沢山資格もってるがちょーさまさまを尊敬します。

コメントありがとうございます。

※じーちゃんの武勇伝?はいつか記事にするかもです。
訪問者さま
カレンダー
09 | 2020/10 | 11
- - - - 1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はらくがき/アクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したいためにExcelのVBAをちょくちょくいじってます。
なお、当ブログはリンクフリーです、よろしければリンク貼ってください。
また、ブロともさまも募集中です。コメントとかもらえるとすごく喜びます。

ブロとも様募集中ですm(_)m

この人とブロともになる

最新コメント
リンク(敬称略)
らくがき
新着記事
参照不可? Oct 20, 2020
基幹システムの入れ替えと使えなくなるファイルメーカー Sep 30, 2020
季節の変わり目 Sep 01, 2020
ロード長くね? Aug 19, 2020
ルフィを描いてみた Aug 17, 2020
囲んで塗る? Aug 14, 2020
100.00cm Aug 12, 2020
サメ Aug 08, 2020
チョット多すぎる Aug 08, 2020
・・・・・・ Aug 06, 2020
カテゴリ
アクセスランキング
[ジャンルランキング]
ブログ
3191位
アクセスランキングを見る>>

[サブジャンルランキング]
イラストブログ
115位
アクセスランキングを見る>>
にほんブログ村(ビオトープ)
月別アーカイブ
人気ブログランキング
更新通知登録ボタン

更新通知で新しい記事をいち早くお届けします

検索フォーム