[[20030417170900]]　『マクロで写真解像度変更をしたいのですが』（まつ）　ページの最後に飛ぶ

『マクロで写真解像度変更をしたいのですが』（まつ）

はじめまして、まつと申します。

写真管理マクロを作成しているのですが、どうしてもわからないので書かせていただきました

写真貼り付け時に指定したサイズには変更できましたが解像度が指定できず、ファイル容量が大きくなってしまうので、写真を貼り付ける際に解像度(640*480程度）にして貼り付けるマクロがあれば教えてください。

Excel2000を使用しています。よろしくお願いします

マクロは現在ここまでです,ご指摘あればよろしくお願い致します

Sub Sump3()

'画像取込み(最新版)

Const z1 As Single = 353 'サイズ指定

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

For Each stc In selnm

  With ActiveSheet.Shapes(ActiveSheet.Pictures.Insert(stc).Name)

  If Err.Number <> 0 Then Err.Clear: GoTo Return_Next

   .Name = "名前" & ico          '名前付け

   .LockAspectRatio = msoFalse   '固定解除

   x1 = .Width                   '横取得

   y1 = .Height                  '縦取得

' .Left = 0 '左位置指定

' .Top = ico '上位置指定

    ActiveCell.Offset(21, 0).Range("A1").Select

     If x1 > y1 Then             '縦横判定

       .Width = z1               '横形

       .Height = y1 * z1 / x1

      Else

       .Height = z1              '縦形

       .Width = x1 * z1 / y1

     End If

  End With

 ico = ico + z1 + 10                '間隔指定

Return_Next:

End Sub

 Excel上で解像度は変更できないですし、[Shape オブジェクト]でVBAヘルプを見ても

 それらしきプロパティもメソッドもありません。

 無理でしょう、多分。

（kazu）

コメント返信：