![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
PowerPointのVBAで、スライド上の図形のサイズを縮小した後、この図形をjpg画像として保存したいです。
オペレーションはこんな感じです↓
図形縮小→図形を選択→右クリック→[図として保存]→JPGファイル名で保存
上記操作を「マクロの記録」で記録したものを実行すると、スライド全体が保存されてしまいます。
また、マクロで.ShapeRange.Exportで画像出力すると、画質が荒くなって出力されます。
画質を落とさず、図形をjpgとして保存する方法はないでしょうか。
よろしくお願い致します。
以下が、現状の私のプログラムです。
Sub Macro()
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="C:\aaaa.JPG", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=-119, Top:=-89, Width:=960, Height:=720).Select
ActiveWindow.LargeScroll ToRight:=1
With ActiveWindow.Selection.ShapeRange
.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft
End With
With ActiveWindow.Selection.ShapeRange
.IncrementLeft 219.12
.IncrementTop 416.75
End With
ActiveWindow.Selection.ShapeRange.Select
'これだと画質が落ちます。↓
Call ActiveWindow.Selection.ShapeRange.Export("C:\\bbb.jpg", ppSaveAsJPG)
'これだとスライド全体が保存されます。↓
' ActivePresentation.SaveAs FileName:="C:\bbb.jpg", FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse
End Sub
No.2ベストアンサー
- 回答日時:
こんにちは。
KenKen_SP です。> PP単体では難しいようでしたら、他の方法に変えたいと思います。
そうアッサリと引き下がらないで頑張ってみましょうよ(;´・ω・`)σ
「専用ソフトではなく、あえて Office ツールでやってみる」という精神は
結構好きです。JPEG 書き出しのサンプルを書いてみました。
▼手順
1. 明熊氏作成の [明熊JPEG保存DLL](フリー) をダウンロード
http://www.vector.co.jp/soft/win95/prog/se093621 …
2. 1. でダウンロードした圧縮ファイルを解凍し、SaveJPG.DLL を Windows
フォルダ内の System32 フォルダへコピー
これで OK です。
PP には CopyPicture メソッドがなかったので、一度ビットマップで書き出し
てから、それを Jpeg 変換しています。Excel ならこの手間が必要ありません。
CopyPicture でクリップボード経由でできますので。詳しくは、SaveJPG.DLL
添付のドキュメントをお読み下さい。
エラー処理とか、Jpeg のファイル名とか画像の挿入部分は省略しました。
付け足してご自分のツールとして完成させていただければ、幸いです。
基本的なメソッドしか使ってませんので、ちょこちょこ書き換えれば Excel や
Word でも動ごくと思います( ・∀・)
それにしても PP が書き出す JPEG はいけてないですね...では。
Option Explicit
' SaveJPG.DLL を Windows\System32 フォルダ内に置いて下さい
Declare Function SavetoJPEG Lib "SaveJPG.DLL" ( _
ByVal bmpf As String, _
ByVal jpgf As String, _
ByVal Value As Byte, _
ByVal Prgrs As Boolean) As Integer
' PP ファイル内の写真を全てスライド上のサイズで JPEG 書き出し
Sub OutputJpegFile()
Dim Sld As Slide
Dim Shp As Shape
Dim strDirPath As String
Dim strTmpname As String
Dim strJpgname As String
Dim lngCounter As Long
' SaveJPG.DLL 設定------------------------------------------
Const QUARITY = 100 ' 画質 1-100
Const PROGRESSIVE = False ' プログレッシブ True/False
'-----------------------------------------------------------
' 現在アクティブな PP ファイルのディレクトリ取得
strDirPath = ActivePresentation.Path
For Each Sld In ActivePresentation.Slides
For Each Shp In Sld.Shapes
' Shape Object は写真か?
If UCase$(Shp.Name) Like "PICTURE*" Then
' 一時ファイル名のビットマップで書き出す
strTmpname = GetTmpFilename(strDirPath)
Shp.Export strTmpname, ppShapeFormatBMP
' ビットマップが書き出されるまで待機
While CBool(Dir$(strTmpname) = "")
DoEvents
Wend
' Jpeg ファイル名生成
strJpgname = strDirPath & "\Picture" _
& Format$(lngCounter, "000") & ".jpg"
' ビットマップを SaveJPG.DLL で Jpeg 変換
Call SavetoJPEG(strTmpname, _
strJpgname, _
QUARITY, _
PROGRESSIVE)
' 一時ファイルを削除
Kill strTmpname
' カウントアップ
lngCounter = lngCounter + 1
End If
Next Shp
Next Sld
End Sub
' 指定フォルダ内で重複しない一時ファイル名を生成する関数
Private Function GetTmpFilename(ByRef strDirPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Do
GetTmpFilename = .BuildPath(strDirPath, .GetTempName)
Loop Until GetTmpFilename <> ""
End With
End Function
さっそく、教えていただいた方法でためしてみました。
Excelでもやってみました。
私のやりたいことが出来ました!!(^^)
本当に感謝です!
わかりやく丁寧な説明をありがとうございました。
No.1
- 回答日時:
単に縮小(または拡大)画像を書き出したいだけなら、PowerPoint(PP)を
使う理由がわかりません。専用ソフトを使った方が綺麗に早く処理できる
からです。
是非とも PP でこの処理を行うご事情があるのであれば、その理由を具体
的に補足して下さい。
これを伺うのは、意図を理解しないで回答したがために発生する余計な
回答を省くのが目的です。PP 単体では恐らく難しいです。外部コンポー
ネント(DLL)を使って Jpg を書き出す方法か別アプリを経由する方法
などを想定しています。
画像をペイント開きサイズを縮小し、保存ファイル名に更新日をつけて保存するというのを手で行なっています。この処理を自動化するためにプログラム作成を考えました。
そこで、私はVBAの知識が少しあるのでマクロの記録を流用して簡単にプログラムができるのではないかと思ったため、マクロを使用しようと思いました。
PP単体では難しいようでしたら、他の方法に変えたいと思います。
ご回答ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) EXCELのグラフを画像(JPG形式)で保存、通常実行がうまく行かない。ステップインはうまく行く 3 2022/08/30 12:06
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) エクセルマクロで教えてください 2 2022/05/04 09:07
- Excel(エクセル) Excelのマクロコードについて教えてください。 1 2022/03/27 10:47
- Windows 10 クリップボードからペイント? 2 2022/09/15 10:01
- Visual Basic(VBA) 複数セルに〇印をつけるマクロ 4 2022/09/07 05:33
- 画像編集・動画編集・音楽編集 jpgが拡張子の画像を探しています 2 2023/04/06 10:03
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/06/09 12:17
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
PowerPointで台形を描く方法
-
pdf上に描画した図形が印刷され...
-
線を組み合わせた図形の塗りつ...
-
グーグルスプレッドシートの図...
-
Excel のバージョンによって、...
-
図形でしずく型を作りたい
-
AutoCADで渦巻きを描く方法
-
Illustratorで白い部分のみを透...
-
エクセルVBAで図形のテキストを...
-
VBA 図形のテキスト取得
-
クリックしたらパネルがめくれ...
-
Excel2003図-扇形を書く方法は...
-
エクセルで図形を連動させたい
-
Illustratorでくくり括弧記号を...
-
パソコンのソフト WordとExcel...
-
excel 図形 正弦波
-
PowerPointで【挿入】→【図】→...
-
G.CREWの使い方
-
WORDで図に網掛けする方法は?
-
エクセル ユーザーフォームに...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
PowerPointで台形を描く方法
-
線を組み合わせた図形の塗りつ...
-
グーグルスプレッドシートの図...
-
pdf上に描画した図形が印刷され...
-
AutoCADで渦巻きを描く方法
-
Excel のバージョンによって、...
-
ワードかエクセルの図形を使っ...
-
Illustratorでくくり括弧記号を...
-
Illustratorで白い部分のみを透...
-
図形でしずく型を作りたい
-
エクセルで図形を連動させたい
-
エクセル ユーザーフォームに...
-
ExcelのVBAコードについて教え...
-
クリックしたらパネルがめくれ...
-
Excel2003図-扇形を書く方法は...
-
おしえてgooに図形の問題を投稿...
-
Jw-cad の図形リストが表示でき...
-
ワードの基本図形で 角丸四角と...
-
【VBA】3個の図形をコピーしてS...
-
エクセルVBAで図形のテキストを...
おすすめ情報