• ベストアンサー

excelのマクロで画像ファイルを操作する方法

winのexcel2003を使っています。 画像を限定されたシート内でランダムに表示する方法を教えてください。 ☆(文字)を1~10個ランダムに、限定されたシート内で表示することはできるのですが、☆の代わりに画像(gifまたはjpeg)を1~10個ランダムに表示できる方法がわかりません。 表示するのはシート1で、表示したい画像は、同じフォルダ内にある画像ファイル(画像1、画像2の2ファイル、大きさは50×50ピクセル程度)または、シート2に貼り付けてある画像ファイルです。 具体的には画像ファイルを指定する方法がわかりません。指定の方法がわかれば何とかなるような気がするのですが… 以下が自分で考えたマクロです。”星の表示”マクロをシート上のボタンに登録して、ボタンをクリックするたびにランダムに星が表示され、メッセージボックスにその数が表示されるはずです。 6個目の星から色が変わるようになっていますが、画像ファイルの場合は1~5個までは画像1を、6個目から画像2を表示できるようにしたいです。たとえば画像1は赤い車、画像2は青い車で、5までは赤い車を、6以上は青い車を表示したいのです。そしてすべての車の数もメッセージボックスに表示するマクロです。 条件に合うような表示ができれば、下のマクロにこだわり必要はありません。質問の仕方が不十分だとは思いますが、よろしくお願いします。 Sub 星の表示()  Dim i As Integer  a = 2  c = Int(10 * Rnd() + 1)  For i = 1 To c    a = 2 + a    Randomize  b = Int(10 * Rnd() + 1)  Cells(b, a).Value = "★"  If i < 6 Then   Cells(b, a).Font.ColorIndex = 3  Else   Cells(b, a).Font.ColorIndex = 4  End If  Next i  MsgBox c  Range("A1:X25").Select  Selection.ClearContents  Range("A1").Select End Sub よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

>または、シート2に貼り付けてある画像ファイルです。 私はこちらの方を Sub 星の表示_sheet2_ver() Dim i As Integer Dim a As Long, b As Long, c As Long a = 2 c = Int(10 * Rnd() + 1) For i = 1 To c a = 2 + a Randomize b = Int(10 * Rnd() + 1) Cells(b, a).Select If i < 6 Then Sheets("Sheet2").Shapes(1).Copy Else Sheets("Sheet2").Shapes(2).Copy End If ActiveSheet.Paste Next i MsgBox c ActiveSheet.Shapes.SelectAll Selection.Delete Range("A1").Select End Sub 参考まで

r-inarin
質問者

お礼

回答ありがとうございます。 シートに貼り付けられている画像を扱うには、shapesを利用すればいいのですね。 期待通りのマクロです。ありがとうございまいました。

その他の回答 (1)

回答No.1

基本的には、ご質問で記述された記述法は変更していません。 ブックと同じフォルダの画像を表示します。 Sub 図の表示()  Dim myDir, Pic1, Pic2, a, b, c, i, rng, shp  myDir = ActiveWorkbook.Path  Pic1 = myDir & "\aaaa.jpg" '実際のファイル名に  Pic2 = myDir & "\bbbb.jpg" '実際のファイル名に  a = 2  c = Int(10 * Rnd() + 1)  For i = 1 To c   a = 2 + a   Randomize   b = Int(10 * Rnd() + 1)   Cells(b, a).Select   If i < 6 Then    ActiveSheet.Pictures.Insert(Pic1).Select   Else    ActiveSheet.Pictures.Insert(Pic2).Select   End If  Next i  MsgBox c  Set rng = Range("A1:X25")  For Each shp In ActiveSheet.Shapes   If Not Intersect(shp.TopLeftCell, rng) Is Nothing Then shp.Delete  Next  Set rng = Nothing  Range("A1").Select End Sub

r-inarin
質問者

お礼

上記の回答の補足で、「ランダムにセルが選択されているようなのですが、その時には画像が貼り付けられず、for~nextのあとに画像が貼り付けられているようです。」と書きましたが、これは間違いでした。セルがランダムに選択されるのですが、それとは別にfor~nextの中で、左上B2付近に画像が貼られます。そこで、以下のようにしてみました。 ActiveSheet.Pictures.Insert(Pic1).Select この.selectを.cutに代えて、ActiveSheet.Pasteを加えました。 for~nextの中を以下のように書き換えました。 For i = 1 To c a = 2 + a Randomize b = Int(10 * Rnd() + 1) Cells(b, a).Select If i < 6 Then ActiveSheet.Pictures.Insert(Pic1).Cut Else ActiveSheet.Pictures.Insert(Pic2).Cut End If ActiveSheet.Paste Next i これでできました。ありがとうございます。misatoannaさんのお陰です。後半の画像を消去するマクロも参考になりました。 お陰で、マクロを使って画像をシート上に貼り付ける方法がわかり、他の場面でも利用できそうです。

r-inarin
質問者

補足

早々にご回答ありがとうございます。 さっそくexcel上で試してみたのですが、画像が1つしか表示されません。ランダムにセルが選択されているようなのですが、その時には画像が貼り付けられず、for~nextのあとに画像が貼り付けられているようです。 また、1の時は表示されず、2以上で表示されます。そして、1~6までが画像aaaa.jpgが、7以上でbbbb.jpgが表示されます。この2点はマクロを修正することで解消しました。 しかし、画像が1つしか表示されないことは、私の力では解決出来ませんでした。 アドバイスをいただければ嬉しいです。よろしくお願いします。

関連するQ&A

  • エクセルのマクロについてなのですが…

    現在マクロを使用して数字の入力を行おうとしております。 セルのB2は変数iを入力(例えば5を入力) 値を入力する範囲はセルのCells(1,1)からCells(i,1)(下記あ~お)に 1~iまでの数字を重複する事無く入力します。 なお、セルのCells(1,1)からCells(i,1)に入力する数字は Rndを使用して乱数にしたいのですが 乱数の入力までは何とか辿り着いたのですが どうしても重複してしまいます。 ネットで調べたのですが、コピレば使えるのですが マクロの意味が良く分からないので 出来れば行ごとの意味も教えていただきたいのですが… ワガママばかりで申し訳ありません。 A B C D 1 あ 2 い 5 3 う 4 え 5 お 6 ・ ・ ・

  • Excel マクロ 値の転記

    Excel マクロ 値の転記 Sheet2をSheet1に転記したいのですが、A列だけは3回同じ値を転記 するのには、※をどのように変えたらいいのでしょうか? 宜しくお願い致します。 〔Sheet1〕転記先 A  B あ  10 あ  20 あ  30 い  40 い  50 〔Sheet2〕転記元 A  B あ  10 い  20 う  30 え  40 お  50 Sub テスト() Dim i As Long For i = 1 To 30    '↓※ココをどう書いて良いのかが分かりません Worksheets("Sheet1").Cells(i, "A") = Worksheets("Sheet2").Cells(i, "A") Worksheets("Sheet1").Cells(i, "B") = Worksheets("Sheet2").Cells(i, "B") Next i End Sub

  • エクセル マクロ 複数セルの色付けについて

    マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1 、問2_2 、問2_10 (全部で問は2_28まであります)等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか? どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub

  • エクセルマクロ 【空白セルを無視する方法を教えてください】

    マクロを独学で学び仕事に応用しているのですが、どうしても分からないことが発生してしまい、質問です。 内容は、今、エクセルシートのA1~B5の範囲で A B 1 1 1 2 1 2 3 4 1 5 1 という形で入力されています(見難くてスミマセン)。 この状態から「A列とB列に同じ数字が入力されてれば、メッセージBOXを表示して、なおかつOKボタンを押したら該当セルを赤くする」というマクロを作りたいのですが、本来であれば1行目のみ赤くなるはずなのですが、空白セルが含まれている3行目も赤くなってしまうんです。つまり、空白セルも「同じ値」と認識されているみたいなのですが...。 この場合、空白セルを無視するにはどうしたらよいのですか?教えてください。なお、マクロは以下のように作っています。 Sub ナンバーチェック() Dim Btn As Integer For X = 5 To 10 If Cells(X, "A").Value = Cells(X, "B").Value Then  Btn = MsgBox("同じ数値です", vbOK, "警告")  If Btn = vbOK Then   Cells(X, "A").Interior.ColorIndex = 3 Cells(X, "B").Interior.ColorIndex = 3 End If End If Next End Sub

  • エクセルVBAで複数シートにマクロ実行

    エクセル2000です。 Sub 行列非表示() For i = 2 To 120 If Cells(i, "A").Interior.ColorIndex = 3 Then Cells(i, "A").EntireRow.Hidden = True End If Next i For n = 1 To 50 If Cells(1, n).Interior.ColorIndex = 3 Then Cells(1, n).EntireColumn.Hidden = True End If Next n End Sub 上記マクロを、シートAAAとCCCとEEEに実行する場合、 Sub test() Sheets("AAA").Activate Call 行列非表示 Sheets("CCC").Activate Call 行列非表示 Sheets("EEE").Activate Call 行列非表示 End Sub と書くよりももっとすっきり実行する方法は無いでしょうか? 各シートの非表示対象の行や列はそれぞれことなります。 また Sub 行列非表示 自体も、もっと効率的にやる方法はないでしょうか?

  • excel VBA ファイル操作 マクロ について

    excel VBA ファイル操作 マクロ についてです。 ファイルAを基本ファイルとし、ファイルBのマクロB1をファイルB上で実行させる方法はあるのでしょうか? (ファイルBのマクロB1をファイルA上で実行する方法はわかるのですが。。。) ファイルBを開いてB1を実行すれば問題ないのですが、ファイルがB~Zなど多数ある場合に、作業効率化したいのです。 その際ファイルBは開いても開かなくてもOKですが、ファイルB上に表示される実行結果は保存したいです。 その結果、エラーが出なければ「正常終了」、エラーが出れば「異常終了」などを、ファイルAに記録するものを作りたいのです。 どなたかご教授お願いいたします。

  • エクセルのマクロについて

    お手数ですが誰か教えてください! BのデーターをAに集計するマクロを作ったのですが 処理速度とっても遅いのです。 高速で処理する方法はありませんでしょうか? 私が作ったマクロ Sub 集計() Dim Z As Integer Dim i As Integer Dim X As Integer For Z = 2 To 2000 For i = 2 To 2000 For X = 3 To 20 If Worksheets("A").cells(Z, 1) = Worksheets("B").cells(i, 1) And       Worksheets("A").cells(1, X) = Worksheets("B").cells(i, 14) Then Worksheets("A").cells(Z, X) = Worksheets("B").cells(i, 16) End If Next X Next i Next Z End Sub       どこかが間違っている気がしますがマクロ初心者のため       先に進めません。       どうかご教授よろしくお願い致します。

  • Excel マクロの一部改造の方法を教えて下さい。

    先日、tom04さんから下記のマクロを教えていただきました。 sheet1のセルA1にsheet2のセルA1からA??までの項目を順次入れ、sheet1を印刷するものです。 これに、追加でsheet1のセルB1にも項目を追加したいのです、データーはsheet2のB1から入れておくこととします。 下記のマクロを教えて下さった、tom04さんの目にとまれば幸いですが、内容を理解して頂いた方ならどなたでも回答頂ければ幸いです。よろしくお願い致します。 改造して頂きたいマクロは下記です。 Sub test() 'この行から Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") '←Sheet名は適宜変更してください Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更 For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("A1") = ws2.Cells(i, 1) '←Sheet1のA1セルに名前を表示 ws1.PrintOut Next i End Sub 'この行まで

  • Excel マクロ 重複チェックについて

    Excel マクロ 重複チェックについて Sheet3のA列とB列に製品番号が入っています。 A列とB列を比較して、A列と同じ番号がB列に2個以上ある場合のみ C列にフラグ「1]を入れたいです。 Sub RetsuCheck() Dim i As Long Dim ws1 As Worksheet Set ws1 = Worksheets("Sheet3") '「Sheet3」シートでA列とB列の重複をチェック。 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row If ws1.Cells(i, "A") = ws1.Cells(i, "B") Then ws1.Cells(i, "C") = 1 End If Next i End Sub 1個の場合には上記マクロで解決するのですが、 2個以上の場合にどうようなマクロを記載すればよいのか アドバイスを頂けませんでしょうか。 よろしくお願いいたします。

  • エクセルマクロで教えてください

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。1TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

専門家に質問してみよう