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

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

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2010/06/07 03:42:41
  • 終了:2010/06/07 19:50:18

ベストアンサー

id:hathi No.3

hathi回答回数204ベストアンサー獲得回数462010/06/07 14:32:43

ポイント50pt

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


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

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

  1つの画像は正方形に変形させて良い。正方形の一辺はB列の幅の1/3とする(横に3画像)

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

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

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


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

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

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


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

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

  

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

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          ' B列(選択していた列)の左端位置

  End With

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

 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

 Next

 mysht.Cells(gr + 1, 2).Select          ' とりあえずB列の次の行を選択

End Sub

id:KAIHATSU

細かくありがとうございます。

全くそのとうりのことをしたかったのです。

ありがとうございます。

2010/06/07 19:46:19

その他の回答(3件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/06/07 10:16:12

ポイント10pt

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

 

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

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

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

(上詰め限定ならばできなくもないです。)


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

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

id:KAIHATSU

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

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

2010/06/07 10:27:54
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/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
id:KAIHATSU

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

2010/06/07 19:44:20
id:hathi No.3

hathi回答回数204ベストアンサー獲得回数462010/06/07 14:32:43ここでベストアンサー

ポイント50pt

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


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

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

  1つの画像は正方形に変形させて良い。正方形の一辺はB列の幅の1/3とする(横に3画像)

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

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

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


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

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

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


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

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

  

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

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          ' B列(選択していた列)の左端位置

  End With

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

 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

 Next

 mysht.Cells(gr + 1, 2).Select          ' とりあえずB列の次の行を選択

End Sub

id:KAIHATSU

細かくありがとうございます。

全くそのとうりのことをしたかったのです。

ありがとうございます。

2010/06/07 19:46:19
id:Koriki-kozou No.4

小力小象回答回数53ベストアンサー獲得回数02010/06/07 18:40:34

ポイント5pt

Little Braver

Little Braver

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

id:KAIHATSU

2010/06/07 19:47:26
  • id:koriki-kozou
    koriki-kozou 2010/06/07 10:56:29
    セル内のテキストは文字単位で大きさも変えられるから位置合わせは面倒だね
    テキストボックスにでもしてしまえるなら画像と同列に扱えるから便利だと思うし
    Excelやめてホームページ作成ソフトでHTML文書として作成してしまうとか考えたほうが楽だと思う
  • id:SALINGER
    上詰め以外の場合でも対応できるものをブログの方にアップしておきました。
    http://d.hatena.ne.jp/SALINGER/20100607
  • id:SALINGER
    >全くそのとうりのことをしたかったのです。
    当方、無駄に質問のレベルを上げてたようです。失礼しました。

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません