[[20211014212045]] 『エクセル内の画像をJPGで保存』(´・ω・`) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『エクセル内の画像をJPGで保存』(´・ω・`)

 エクセル内の画像をJPG保存したいという場面は結構あります

 365だと画像を選択して右クリックで、【図として保存】という項目があって
 これを選択すると、PNG,JPG,GIF,TIFF,BMP,SVGなどのフォーマットで保存する
 ダイアログがでて、JPGで保存出来たりするわけです。

 ただ、これをマクロの記録しても、コードには何も記録されません。

 で、オブジェクトブラウザで調べると、非表示メンバーの中に、
 Office.Shapeクラスのメンバーとして、
 Sub SaveAsPicture(PictureType As MsoPictureType, FileName As String, FSaveShapesIndividually As Boolean)
 というのがありました。
 
 なので、こんなマクロを組んでみると、実行時エラーになります。
 Sub test()
   Dim shp As Office.Shape
   Set shp = ActiveSheet.Shapes(1)   ' ここで 型が一致しません のエラー
   shp.SaveAsPicture msoPictureTypeJPG, "test.jp", True 
 End Sub

 ExcelのShapeを Office.Shapeに代入する方法ご存じでしたらご教授お願いします。 

< 使用 Excel:Office365、使用 OS:Windows10 >


 直感ですいません。少しでも参考になれば的だけなので、完全理解して言ってる訳ではありません。
ごめんなさい。(_ _。)

 >Office.Shapeクラスのメンバーとして、
 >Sub SaveAsPicture(略, FileName As String, 略)

 の FileName As String が気になります。

 ◆参考になるかわかりません

 Shape オブジェクト (Excel)
 https://docs.microsoft.com/ja-jp/office/vba/api/excel.shape

 昨夜も、同じような事を質問してた人がいましたですよ。こちらはファイル保存ですが
 『エクセル内の画像をJPG保存』(harukaze)

 https://www.excel.studio-kazu.jp/kw/20211013095427.html

(あみな) 2021/10/14(木) 23:56


手元のExcel2019で確認しましたら、まったく同様の結果でしたね。

続けて余談で失礼します。
こうした非表示のオブジェクトやメソッドなどは
過去との整合性のために持っているものが割と多い印象です。

ただ、2010のオブジェクトブラウザーではOffice.Shapeにそうしたメソッドはないですね。
ということは、2013以降に入れたが、現時点では未使用になっている
ということなんでしょうか。
今後のために実験用として入れているとかでしょうか。
(γ) 2021/10/15(金) 07:30


 あみなさんγさん回答ありがとうございます。

 >昨夜も、同じような事を質問してた人がいましたですよ
 そのスレがきっかけで、これを調べてます
 365だったら標準の一般操作でできるのになとおもったら、マクロ記録できなったので。

 >2013以降に入れたが、現時点では未使用になっている
 2013でもOffice.Shapeクラスに見当たらないので、その後だと思います。

 ネットで検索してもなかなかこれという情報がヒットせず、よくわからないままですが、
 いずれバージョンが上がるにつれ、VBAでも使えるようになるといいなと期待しています
(´・ω・`) 2021/10/15(金) 08:48

今さらですが、
Publisher(パブリッシャー)を購入済みであることが必要のようです。
https://www.dospara.co.jp/5info/cts_str_pcuse_publisherpoint
2022で標準搭載になるのだろうか?

私のExcelは2016(365表示)で、Publisherは当然無く、office.shape.SaveAsPictureは使えません。
ですが、PowerPonitの同じく非表示のSlide.Shape.Exportは動作します。
解像度96dpiで遅いですが、chart.exportと違って右・下に余白が出来ないので、PowerPoint経由もありかなと思います。

 Sub PowerPoint経由()
    Const ppShapeFormatJPG = 1, ppShapeFormatPNG = 2
    Dim shp As Shape
'    Dim PPslide As Object
    Dim strFol  As String
    Dim sel
    Dim flg As Boolean

    strFol = ThisWorkbook.Path
    Application.ScreenUpdating = False  'slideとの切り替え更新は止まらない
    With ActiveSheet
        Set sel = Selection
        If TypeName(sel) <> "Range" Then Set sel = .Range("A1")
        On Error Resume Next
        Set shp = .Shapes("PowerPoint")
        On Error GoTo 0
        If shp Is Nothing Then
            .Shapes.AddOLEObject("PowerPoint.Slide.12", Left:=Range("O1").Left).Name = "PowerPoint"
            '                 ↑バージョンはお持ちのものに合わせて下さい
            Set shp = .Shapes("PowerPoint")
            flg = True                  '挿入時はslideが有効なようだ
        End If

        '適当な図をcopy
        With .Range("B11:F28")
            .Cells(1).Interior.Color = vbRed
            .Cells(.Cells.Count).Interior.Color = vbYellow
            .CopyPicture
            .Interior.Color = xlNone
        End With

        If Not flg Then shp.DrawingObject.Verb xlPrimary    'object(slide)を有効化
        shp.Visible = False
        sel.Select                          '表示をslideからexcelに戻す

 '        Set PPslide = shp.DrawingObject.Object
        With shp.DrawingObject.Object   'PPslide
            .Shapes.Paste
            .Shapes(.Shapes.Count).Export strFol & "\PPTest.jpg", ppShapeFormatJPG
            .Shapes(.Shapes.Count).Delete
        End With
    End With
    Application.ScreenUpdating = True
 End Sub

(kazuo) 2021/10/22(金) 18:27


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.