VBA エクセル

質問

回答が不十分の為再質問させていただきます。
http://oshiete1.goo.ne.jp/qa2837887.html

整理すると
現状の質問は貼り付け先の記載方法

貼り付け後の写真大きさ変更及びセル位置指定方法
（複数の写真あり）

を質問中です
宜しくお願い申し上げます

回答No.4

meron_ · ベストアンサー

依然としてどのような手順でなにをしたいのかつかめませんが・・

複数選択した画像はワークシート上にどのような形（ｎ列×ｎ行）で
配置したいのかわかると答えやすいです。

> A1に貼り付けたいです
だけではA1に複数の画像を重ねるのかな？？と思います。

ANo.3さんの言うとおり、情報が不足しているため何度も補足して頂けないとこれ以上は回答できなくなります。

私もキメウチさせてヒントを書いておきます。

GetOpenFilenameメソッドでMultiSelect:=Trueとした場合
たとえ１個のファイルを選択した場合でもファイル名がバリアント型変数に配列として格納されます。
したがって、

For i = 1 To UBound(Fname)

★ここでシート上に画像を挿入

Next i

と配列の数だけ画像を挿入すればいいのです。
画像の挿入方法はこれまでの回答を参考にもう一度考えてください。

その上で、どの部分がわからないかを質問してください。
どうかよろしくお願いいたします。

回答No.3

Wendy02

こんばんは。

ちょっと割り込ませていただきます。

前のご質問で、たぶん、回答者さんが、完成を目指していたのに、そのまま閉めたから、文句がついたのだと思います。ご質問自体は、作成依頼とは思いませんが、これは、もう、最初から、キメウチ的に進めなくてはならないのに、情報が不足しているので、回答者側には、内容として重過ぎます。ある程度、回答者さんと質問者さんの信頼関係が出来ていればよいのですが、そうでないと、なかなか、手を出しにくいという部分があります。また、信頼関係を作るなら、中途半端で閉めないほうがよいです。（その見極めは難しいですが、ご質問の内容が、ここにあっているかは、少し様子をみたほうが良いことが多いです。）

こちらとしては、作成依頼とは思いませんので、こちらで、キメウチさせていただきました。しかし、基本的には、Excelのワークシートでは、大量にオブジェクトを置くことは出来ません。

>開発だと一個しか指定できなくて悩んでました。
>sFilter = "全ての図 (*.jpg;*.bmp;*.gif), *.jpg;*.bmp;*.gif"

種類自体を、1本、２本に決めてしまうこととです。

これを参考に、何とか、後を修正してくださるようにお願いします。

'-------------------------------------------------

Sub PastePictures()
　　Dim sFilter As String
　　Dim retValue As Variant
　　Dim fn As Variant
　　Dim tp As Double
　　Dim le As Double
　　Dim i As Integer

　　sFilter = "全ての図 (*.jpg;*.bmp;*.gif), *.jpg;*.bmp;*.gif"
　　On Error Resume Next
　　retValue = Application.GetOpenFilename(sFilter, , "図の挿入", , True)

　　If Not IsArray(retValue) Then Exit Sub
　　On Error GoTo 0

　　For Each fn In retValue
　　　'横に2列
　　　　tp = 200 * Int(i / 2) + 20 '(+20は余白)
　　　　le = 300 * (i Mod 2) + 20

　　　　ActiveSheet.Shapes.AddPicture fn, False, True, le, tp, 300, 200
　　　　i = i + 1
　　Next
End Sub

回答No.2

meron_

「したい事」ばかり書くと、禁止事項の［作成依頼目的］に該当します。
「わかない部分」を書いてください。

ヒント：

セルの大きさに画像を合わせたい場合、
一般的なデジカメの縦横比は３：４なので、もしデジカメ写真のファイルなら
あらかじめセルの大きさを３：４ にしておく。

次に、

既存の画像ファイルから図を作成します。

　● 詳細 ●

構文 Object.AddPicture(FileName, LinkToFile, SaveWithDocument,
Left, Top, Width, Height)

設定項目 内容
Object Shapesコレクションオブジェクト [省略不可]
FileName 挿入する画像ファイル名をパス付きで指定 [省略不可]
LinkToFile Trueで元のファイルとのリンクが設定、
Falseで独立した画像 [省略不可]
SaveWithDocument Trueではエクセルファイルとともに保存、
Falseではリンク情報だけを保存 [省略不可]
Left 挿入する画像の左端位置を指定 [省略不可]
Top 挿入する画像の上端位置を指定 [省略不可]
Width 挿入する画像の幅を指定 [省略不可]
Height 挿入する画像の高さを指定 [省略不可]

補足

分からない部分は
Dim Fname
Dim T As Collection

Fname = Application.GetOpenFilename _
(FileFilter:="JPEGファイル(*.JPG;*.JPEG;*.JPE),*.JPG;*.JPEG;*.JPE,TIFFファイル(*.TIF),*.TIF,PNGファイル(*.PNG),*.JPG,すべてのファイル(*.*), *.*", _
Title:="画像ファイル選択", MultiSelect:=True)
If IsArray(Fname) = False Then
If Fname = False Then
MsgBox "「キャンセル」されました"
End If
Else
　　　　’★ココで写真を配置する
End If

の★ココで写真を配置するの記載方法が分かりません。

尚、当方の作成方法は
Dim sFilter As String
Dim retValue

sFilter = "全ての図 (*.jpg;*.bmp;*.gif), *.jpg;*.bmp;*.gif"
sFilter = sFilter & ",JPEG ファイル (*.jpg), *.jpg"
sFilter = sFilter & ",ビットマップ ファイル (*.bmp), *.bmp"
sFilter = sFilter & ",GIF ファイル (*.gif), *.gif"
'GetOpenFilename _
' (FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
retValue = Application.GetOpenFilename _
(sFilter, 2, "図の挿入", , False)
'AddPicture _
' (FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
If retValue <> False Then
ActiveSheet.Shapes.AddPicture retValue, _
False, True, 0, 0, 300, 200
End If
で作成しており少し異なることからmeron_様の方法で作成しなおしをしていた所です。
上記での開発だと一個しか指定できなくて悩んでました。

作成依頼をした覚えはないですので作成依頼と思われる場合は書き込み等行わないようにして下さい。
考え方の違いでしょうか？
回答等迅速な対応には感謝しております。
ありがとうございました。

回答No.1

meron_

> 回答が不十分
とありますが、なぜ締め切られたのでしょうか？
回答が不十分・・と言うよりも質問の内容、補足に対する回答も
説明不足です。

前の質問で、
> 貼り付先もお願いします。
とありますが、貼り付先の何を何したいのかよくわかりません。

もう一度、何をどうしたいのかを解りやすく順に書いてください。
そうすれば、回答が得られやすくなります。

補足

お返事ありがとうございます

申しわけありません
目立たす為に一旦取り消して再度同じ質問をしました。
ご気分悪くさせて申し訳ありません。
貼り付けはサイズ指定しA1に貼り付けたいです。

申し訳ありません