| |
▼HK さん：
ponponです。こんばんは。
私もネット上で偶然見つけたものですから、サンプルとして保存していたものです。
詳しいことは、常連さんの回答を待つとして、
私に考えられることは、
Sub 取込()
'画像取込み
Const z1 As Single = 100 'サイズ指定
'↑ここで表示のサイズが変えられます。
Dim ico As Long, stc As Variant, selnm As Variant
Dim x1 As Single, y1 As Single
'ChDir "D:\Other
selnm = Application.GetOpenFilename(Title:="Ctrl、矢印ドラッグで複数選択", _
MultiSelect:=True)
If Not IsArray(selnm) Then MsgBox "キャンセルされました": Exit Sub
ico = 30 '最上位の位置
On Error Resume Next
With ActiveSheet 'Sheet指定
For Each stc In selnm
'↑ここでFor Each を使うのではなく、for nextを使って、selnmに格納され
' ている画像の枚数を取得して、.Shapes(.Pictures.Insert(stc).Name)の貼
' り付ける位置を１枚目から５枚まではこのまま、５枚から１０枚までは、
' その横にというように指定してやる必要があると思います。
' 初心者ですからコード化するには時間がかかります。
' ↓ここのように
'http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=21061;id=excel
With .Shapes(.Pictures.Insert(stc).Name)
If Err.Number = 0 Then
.Name = Dir(stc, vbNormal) '名前付け
.LockAspectRatio = msoTrue '固定
x1 = .Width '横取得
y1 = .Height '縦取得
.Left = 0 '左位置指定
.Top = ico '上位置指定
If x1 > y1 Then '縦横判定
.Width = z1 '横形
.Height = y1 * z1 / x1
Else
.Height = z1 '縦形
.Width = x1 * z1 / y1
End If
ico = ico + z1 + 10 '間隔指定
Else
Err.Clear 'ErrReset
End If
End With
Next
End With
End Sub
>>こちらが参考になると思います。
>>↓
>>http://oshiete1.goo.ne.jp/kotaeru.php3?q=1176693
>>エクセルでなくてもよいなら
>>http://hulatt.hp.infoseek.co.jp/SlideShow.html
>お礼の返事遅れまして申し訳ありません。
>取込み画像のマクロ大変便利です。有り難うございました。
>マクロの意味が解れば、もう少し思い通りのサイズとか出来ると思うのですが、
>まことに勝手なお願いとは思いますが、差し支えなければ教えていただけないでしょうか。
|
|
ponpon
- 05/2/24(木) 0:13 -
