エクセルにＶＢＡで画像を挿入したいと考えていますが、少し特殊で悩んでいます

Question

KAIHATSU

11

11もっと見る

95pt

コンピュータインターネット

エクセルにＶＢＡで画像を挿入したいと考えていますが、少し特殊で悩んでいます

挿入したい画像は指定フォルダに格納しています。
添付した画像のように、文字の次の行へ画像の大きさを指定して挿入していきたいのです。
しかも3つ以上画像がある商品だと、画像の下へ挿入しなければなりません。
どうにか方法はないでしょうか？よろしくお願いします。

回答の条件

1人5回まで

登録：2010/06/07 03:42:41
終了：2010/06/07 19:50:18

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.1

SALINGER34549692010/06/07 10:16:12

10pt

コメント欄がオープンされていないのでこちらで失礼します。

Excelの場合画像は、セルの文字と同じレベルではなくて、画像がセルの上に重なることになります。

その為文字の位置に合わせて画像の位置を調整しなくてはならないのですが、

文字の位置は縦方向に上詰めや中央揃えがあるので特定するのは難しいと思います。

（上詰め限定ならばできなくもないです。）

回答ではありませんので、ポイントは不要です。

http://q.hatena.ne.jp/

回答ありがとうございました。

やはり無理があるのでしょうか

2010/06/07 10:27:54

No.2

SALINGER34549692010/06/07 11:35:59

30pt

商品名のところが上詰めのときに使える方法を紹介しておきます。

トリッキーではありますが、セルの高さをオートフィットして計り画像を挿入する高さを求める方法です。

そのサンプルコードを紹介しておきます。

挿入するセルを選択して実行すると、画像の保存されているフォルダを聞いてきますので

指定するとコードの最初の方で指定しているサイズで画像を挿入します。picMarginは画像と画像の間隔です。

ここでは指定したサイズに画像を伸縮して挿入していますので、

縦横比を維持して挿入という場合は、コードの変更が必要となります。

Sub 画像挿入()
    Const picHeight As Double = 100
    Const picWidth As Double = 60
    Const picMargin As Double = 10
    Dim topPoint As Double
    Dim buf As String
    Dim i As Integer
    Dim myShape As Shape
    
    If TypeName(Selection) <> "Range" Then
        MsgBox "画像を挿入セルを選択してください"
        Exit Sub
    End If
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Selection.Copy Range("A65536")
            Rows(65536).AutoFit
            If Selection.Row = 1 Then
                topPoint = Rows(65536).Height
            Else
                topPoint = Rows("1:" & Selection.Row - 1).Height + Rows(65536).Height
            End If
            Rows(65536).Delete
            buf = Dir(.SelectedItems(1) & "\*.*")
            Do While buf <> ""
                On Error Resume Next
                Set myShape = ActiveSheet.Shapes.AddPicture(buf, _
                    LinkToFile:=False, SaveWithDocument:=True, _
                    Left:=Selection.Left + (i Mod 3) * (picWidth + picMargin), _
                    Top:=topPoint + Int(i / 3) * (picHeight + picMargin), _
                    Width:=picWidth, Height:=picHeight)
                On Error GoTo 0
                i = i + 1
                buf = Dir()
            Loop
        End If
    End With
End Sub

何とかできそうです。ありがとうございます

2010/06/07 19:44:20

No.4

小力小象5302010/06/07 18:40:34

5pt

Little Braver

アーティスト: Girls Dead Monster
出版社/メーカー: アニプレックス
発売日: 2010-06-09
メディア: CD

？

2010/06/07 19:47:26

koriki-kozou 2010/06/07 10:56:29

セル内のテキストは文字単位で大きさも変えられるから位置合わせは面倒だね
テキストボックスにでもしてしまえるなら画像と同列に扱えるから便利だと思うし
Excelやめてホームページ作成ソフトでHTML文書として作成してしまうとか考えたほうが楽だと思う
SALINGER 2010/06/07 19:50:52

上詰め以外の場合でも対応できるものをブログの方にアップしておきました。
http://d.hatena.ne.jp/SALINGER/20100607
SALINGER 2010/06/07 20:27:29

＞全くそのとうりのことをしたかったのです。
当方、無駄に質問のレベルを上げてたようです。失礼しました。

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

hathi · Accepted Answer · 2010-06-07T14:32:43+09:00

意図を正しく理解していないかもしれませんが、次のようなものでも参考になるでしょうか。

私が想定したイメージは、

　　必ずＢ列の1セルに画像が表示された見え方にする（シートに挿入して配置）

　　１つの画像は正方形に変形させて良い。正方形の一辺はＢ列の幅の1/3とする（横に3画像）

　　１セルに表示する画像は、1つのフォルダに入っている（個数は不定）

　　１つのセルに表示させるので、該当行の高さは画像数に応じて調整する

　　１つのフォルダには画像ファイル以外のファイルは含まれていない

次のマクロは、FileSystemObjectの機能を使用します

　　　参照設定の方法は、ＶＢＥで、プロジェクト＞参照設定で、Microsoft Scripting Runtimeの参照にチェックを入れるだけです。

　　　この仕組みを利用すると、フォルダ内のファイルを参照したり操作するのが楽です。

マクロのコード例　（コピーして貼り付けてください）

　　　my1f = "C:\Documents and Settings\………\画像２" 　のところは、ご自身の環境でお願いします。

　　　インデントをうまく表現できていないので、わかりにくいかもしれませんが、、、

Sub Macro例()

　Dim myFSO As Scripting.FileSystemObject

　Dim myFiles As Scripting.Files, myF As Scripting.File

　Dim mysht, my1f

　Const Fs = 9　 '　フォントサイズ　仮に9ポイントだとして

　Dim gt, gl, gr, gh　 '　gt=指定した行の画像のTOP位置 gl=指定列の左端 gr=指定した行No gh=指定した行に設定する高さ

　Dim sh, sw　 '　セル内に表示する画像の高さ、幅　　幅は、B列幅の1/3

　Set myFSO = New Scripting.FileSystemObject

　Set mysht = ActiveSheet

　　　'　B列の幅から　表示する画像の大きさ（幅と高さ）を決める

　　rw = mysht.Columns("B").Width: sw = Int(rw / 3): sh = sw

　　　'　マクロ実行前に、画像を入れたいB列のセルを選択しているとして

　　With Selection

　　　　.VerticalAlignment = xlTop　　'　セルに表示する文字をセルの上部に位置づけて

　　　　gr = .Row　　　　　　　　　　　' 選択していた行の番号

　　　　gt = Fs * 1 + .Top　　　　　　'　セルTOPから1文字高さ分下に、画像を表示させるTOP位置を決める

　　　　gl = .Left　　　　　　　　　　'　Ｂ列(選択していた列)の左端位置

　　End With

　my1f = "C:\Documents and Settings\………\画像２"　'　画像ファイルだけがあるフォルダのパス

　Set myFiles = myFSO.GetFolder(my1f).Files　　　　　'　指定したフォルダにある全画像ファイルの取得

　zn = myFiles.Count　　　　　　　　　　　　　　　　　'　指定したフォルダにある画像ファイル数の取得

　Rows(gr).RowHeight = Fs + ((zn - 1) \ 3 + 1) * sh　'　行の高さを画像ファイル数に合わせて設定する

　zn = 0　　　　　　　　　　　　　　　　　　　　　　'　取り込む画像の番号のカウンタに使う

　For Each myF In myFiles

　　　zn = zn + 1

　　　mysht.Pictures.Insert(myF).Select

　　　With Selection

　　　　　　.Height = sh　　　　　　　　　　　　'　画像の高さを調整

　　　　　　.Width = sw　　　　　　　　　　　　　'　画像の幅を調整

　　　　　　.Top = gt + ((zn - 1) \ 3) * sh　　　'　画像の上部位置を調整

　　　　　　.Left = gl + ((zn - 1) Mod 3) * sw　　'　画像の左端位置を調整

　　　End With

End Sub

hathi · Accepted Answer · 2010-06-07T14:32:43+09:00

意図を正しく理解していないかもしれませんが、次のようなものでも参考になるでしょうか。

私が想定したイメージは、

　　必ずＢ列の1セルに画像が表示された見え方にする（シートに挿入して配置）

　　１つの画像は正方形に変形させて良い。正方形の一辺はＢ列の幅の1/3とする（横に3画像）

　　１セルに表示する画像は、1つのフォルダに入っている（個数は不定）

　　１つのセルに表示させるので、該当行の高さは画像数に応じて調整する

　　１つのフォルダには画像ファイル以外のファイルは含まれていない

次のマクロは、FileSystemObjectの機能を使用します

　　　参照設定の方法は、ＶＢＥで、プロジェクト＞参照設定で、Microsoft Scripting Runtimeの参照にチェックを入れるだけです。

　　　この仕組みを利用すると、フォルダ内のファイルを参照したり操作するのが楽です。

マクロのコード例　（コピーして貼り付けてください）

　　　my1f = "C:\Documents and Settings\………\画像２" 　のところは、ご自身の環境でお願いします。

　　　インデントをうまく表現できていないので、わかりにくいかもしれませんが、、、

Sub Macro例()

　Dim myFSO As Scripting.FileSystemObject

　Dim myFiles As Scripting.Files, myF As Scripting.File

　Dim mysht, my1f

　Const Fs = 9　 '　フォントサイズ　仮に9ポイントだとして

　Dim gt, gl, gr, gh　 '　gt=指定した行の画像のTOP位置 gl=指定列の左端 gr=指定した行No gh=指定した行に設定する高さ

　Dim sh, sw　 '　セル内に表示する画像の高さ、幅　　幅は、B列幅の1/3

　Set myFSO = New Scripting.FileSystemObject

　Set mysht = ActiveSheet

　　　'　B列の幅から　表示する画像の大きさ（幅と高さ）を決める

　　rw = mysht.Columns("B").Width: sw = Int(rw / 3): sh = sw

　　　'　マクロ実行前に、画像を入れたいB列のセルを選択しているとして

　　With Selection

　　　　.VerticalAlignment = xlTop　　'　セルに表示する文字をセルの上部に位置づけて

　　　　gr = .Row　　　　　　　　　　　' 選択していた行の番号

　　　　gt = Fs * 1 + .Top　　　　　　'　セルTOPから1文字高さ分下に、画像を表示させるTOP位置を決める

　　　　gl = .Left　　　　　　　　　　'　Ｂ列(選択していた列)の左端位置

　　End With

　my1f = "C:\Documents and Settings\………\画像２"　'　画像ファイルだけがあるフォルダのパス

　Set myFiles = myFSO.GetFolder(my1f).Files　　　　　'　指定したフォルダにある全画像ファイルの取得

　zn = myFiles.Count　　　　　　　　　　　　　　　　　'　指定したフォルダにある画像ファイル数の取得

　Rows(gr).RowHeight = Fs + ((zn - 1) \ 3 + 1) * sh　'　行の高さを画像ファイル数に合わせて設定する

　zn = 0　　　　　　　　　　　　　　　　　　　　　　'　取り込む画像の番号のカウンタに使う

　For Each myF In myFiles

　　　zn = zn + 1

　　　mysht.Pictures.Insert(myF).Select

　　　With Selection

　　　　　　.Height = sh　　　　　　　　　　　　'　画像の高さを調整

　　　　　　.Width = sw　　　　　　　　　　　　　'　画像の幅を調整

　　　　　　.Top = gt + ((zn - 1) \ 3) * sh　　　'　画像の上部位置を調整

　　　　　　.Left = gl + ((zn - 1) Mod 3) * sw　　'　画像の左端位置を調整

　　　End With

End Sub

エクセルにＶＢＡで画像を挿入したいと考えていますが、少し特殊で悩んでいます

ベストアンサー

hathi216492010/06/07 14:32:43

その他の回答（3件）

SALINGER34549692010/06/07 10:16:12

SALINGER34549692010/06/07 11:35:59

hathi216492010/06/07 14:32:43ここでベストアンサー

小力小象5302010/06/07 18:40:34

コメント（3件)

この質問への反応（ブックマークコメント）