人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

1275849757
●拡大する

●質問者: KAIHATSU
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル フォルダ 画像
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● SALINGER
●10ポイント

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

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

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

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

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


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

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

◎質問者からの返答

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

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


2 ● SALINGER
●30ポイント

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

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

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


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

指定するとコードの最初の方で指定しているサイズで画像を挿入します。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
◎質問者からの返答

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


3 ● hathi
●50ポイント ベストアンサー

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


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

必ず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

◎質問者からの返答

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

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

ありがとうございます。


4 ● 小力小象
●5ポイント

Little Braver

Little Braver

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

◎質問者からの返答

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ