No.3ベストアンサー
- 回答日時:
某掲示板でshiraさんという方から教わったコードをアレンジさせていただきました。
宣言部は別途投稿します。Sub test()
Dim src As String,dst As String
src="c:\s.jpg"
dst="c:\d.jpg"
If Dir(dst) <> "" Then Kill (dst)
Call resizePicture(src,dst,20,7,70)
End Sub
Function resizePicture(ByVal srcPath As String,_
ByVal dstPath As String,_
Optional ByVal scalerate As Long=100,_
Optional ByVal InterpolationMode As InterpolationMode=InterpolationModeHighQualityBicubic,_
Optional ByVal jpegQuality As Long=85)
Dim IID_IDispatch As GUID
Dim pd As PICTDESC
Dim udtInputAs GdiplusStartupInput
Dim lngTokenAs Long,lngStatus As Long
Dim pGraphics As Long
Dim pSrcBmp As Long,pDstBmp As Long
Dim lngWidthAs Long,lngHeight As Long
Dim EncodParameters As EncoderParameters
udtInput.GdiplusVersion=1
If GdiplusStartup(lngToken,udtInput,ByVal 0&)<>0 Then
Exit Function
End If
If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath),pSrcBmp)<>0 Then
GdiplusShutdown lngToken
Exit Function
End If
GdipGetImageWidth pSrcBmp,lngWidth
GdipGetImageHeight pSrcBmp,lngHeight
lngWidth=lngWidth * scalerate \ 100
lngHeight=lngHeight * scalerate \ 100
If GdipGetImageGraphicsContext(pSrcBmp,pGraphics)=0 Then
lngStatus=GdipCreateBitmapFromGraphics(lngWidth,lngHeight,pGraphics,pDstBmp)
GdipDeleteGraphics pGraphics
If lngStatus=0 Then
If GdipGetImageGraphicsContext(pDstBmp,pGraphics)=0 Then
GdipSetInterpolationMode pGraphics,InterpolationMode
GdipDrawImageRectI pGraphics,pSrcBmp,0,0,lngWidth,lngHeight
GdipDeleteGraphics pGraphics
EncodParameters.Count=1
With EncodParameters.Parameter(0)
.GUID=ConvCLSID(CLSID_Quality)
.NumberOfValues=1
.Type=4
.Value=VarPtr(jpegQuality)
End With
Call GdipSaveImageToFile(pDstBmp,StrPtr(dstPath),ConvCLSID(CLSID_JPEG),VarPtr(EncodParameters))
End If
GdipDisposeImage pDstBmp
End If
End If
GdipDisposeImage pSrcBmp
GdiplusShutdown lngToken
End Function
Private Function ConvCLSID(ByVal sGuid As String) As GUID
CLSIDFromString StrPtr(sGuid),ConvCLSID
End Function
No.6
- 回答日時:
#3です。
前から気になっていたのですが、ようやく原因がわかりました。リサイズの補間モードが、
InterpolationModeHighQualityBicubic
だと、左端と、上端に灰色の線が出来てしまいます。白基調の画像だと気になると思います。
InterpolationModeBicubic (=4)
等を選択するか、事前に白で塗りつぶしておく様にしてください。
GdipSetInterpolationMode pGraphics, InterpolationMode
'------- これを追加 dim hBrush as long を宣言要
GdipCreateSolidFill &HFFFFFFFF, hBrush
GdipFillRectangle pGraphics, hBrush, 0, 0, lngWidth, lngHeight
GdipDeleteBrush hBrush
'------- ここまで
GdipDrawImageRectI pGraphics, pImageTemp, 0, 0, lngWidthd, lngHeightd
No.5
- 回答日時:
#2です
簡単に出来るかと思ったら、かなり、面倒でした。
VBAのオブジェクトブラウザでは、ないコマンドが
オートマクロで、達成されていたり、
vbaのヘルプを見たら、
画像フォーマットを変えられそうだったのですが。
それも出来なかったみたいでです。
でも、jpegの画像ファイルを、1/5のサイズに変換するのが
実に、単純な、コードで終わりました。
でも、保存された画像は、jpegになるかどうかは、
結果を見てみないと解らないみたいです。
Public Sub f()
ActiveSheet.Pictures.Insert("filepath.JPG").Select
Selection.ShapeRange.Width = Selection.ShapeRange.Width / 5#
Selection.ShapeRange.Height = Selection.ShapeRange.Height / 5#
ActiveWorkbook.SaveAs Filename:= "Book1.htm",FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
単純な、動作なので、自分でオートマクロで作ってみたら、
確実なコードが、得られると思います。
簡便方としては、良いのでは、ないですか??
No.4
- 回答日時:
#3の続きというか、こちらの方が前なのですが。
GDI+の関数名は長いので、2K文字に納めるのに疲れました。不足する関数・定数はhttp://okwave.jp/qa/q5124395.html
のKenKen_SPさんのご回答をご参照下さい。
Public Enum GDIPlusStatusConstants
Ok = 0
'(略)
End Enum
Public Enum InterpolationMode
'(略)
InterpolationModeBilinear = 3
InterpolationModeBicubic = 4
InterpolationModeNearestNeighbor = 5
InterpolationModeHighQualityBilinear = 6
InterpolationModeHighQualityBicubic = 7
End Enum
Type PICTDESC
cbSizeofstruct As Long
picType As Long
hbitmap As Long
hpal As Long
unused_wmf_yExt As Long
End Type
Declare Function GdipGetImageGraphicsContext Lib "gdiplus" _
(ByVal image As Long, graphics As Long) As Long
Declare Function GdipDeleteGraphics Lib "gdiplus" _
(ByVal graphics As Long) As Long
Declare Function GdipSetInterpolationMode Lib "gdiplus" _
(ByVal graphics As Long, _
ByVal nInterpolationMode As InterpolationMode) As Long
Declare Function GdipGetImageWidth Lib "gdiplus" _
(ByVal image As Long, Width As Long) As Long
Declare Function GdipGetImageHeight Lib "gdiplus" _
(ByVal image As Long, Height As Long) As Long
Declare Function GdipDrawImageRectI Lib "gdiplus" _
(ByVal graphics As Long, ByVal image As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal Width As Long, ByVal Height As Long) As Long
Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
(fileName As Any, bitmap As Long) As Long
Declare Function GdipCreateBitmapFromGraphics Lib "gdiplus" _
(ByVal Width As Long, ByVal Height As Long, _
ByVal target As Long, bitmap As Long) As Long
Const CLSID_JPEG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Const CLSID_Quality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
mitarashiさん
ご丁寧にコードの記述ありがとうございます。
内容確認しながら試してみます。
ほんとにありがとうございます。
No.1
- 回答日時:
この回答への補足
ご回答ありがとうございます。
明熊JPEG保存DLL
は自分もネットで見つけましたが
自分のPC以外でも作業する場合があるので
他の方法を探していました。
質問には書いておりませんでした。
ご回答くださったのにすみません。。。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) Excel 毎日手作業で時間がかかって、泣きたいです、、、VBAのプロの方、助けてください。。。 3 2022/10/25 04:26
- その他(ソフトウェア) 画像のファイル形式、拡張子が変わると、性能が変わると思うのですが、ファイル名の「jpg、png、do 8 2022/08/10 13:37
- Windows 10 windows 10の操作で 質問です 3 2023/05/11 11:13
- PHP $filePath = './user_img/' . $file['name'];? 1 2022/12/10 07:29
- その他(ソフトウェア) コマンドプロンプトについて教えてください。 状況: 画像編集ソフト上でネットから保存した画像を使うの 3 2022/05/26 11:14
- Windows 10 *jpgファイルと日付データだけをホルダに移動するには 1 2023/01/16 22:19
- Excel(エクセル) EXCELのグラフを画像(JPG形式)で保存、通常実行がうまく行かない。ステップインはうまく行く 3 2022/08/30 12:06
- その他(OS) Windowsで大量の画像サイズを半自動で変更する方法 6 2023/02/17 08:45
- Windows 10 JPG PNG サポートされていない形式 (JPGファイルで開ける、開けないがある場合) 4 2022/04/23 13:46
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、
Excel(エクセル)
-
VBAで画像圧縮はできますか?
Visual Basic(VBA)
-
Excel マクロ 画像をリンクせずかつ圧縮して貼りつける方法を教えてください
Excel(エクセル)
-
-
4
オートシェイプをJPG保存
Visual Basic(VBA)
-
5
VBAにGDI+を参照させる方法
Visual Basic(VBA)
-
6
bmp画像をjpegやpng画像に圧縮する方法
Visual Basic(VBA)
-
7
エクセルでエラーが出て困っています。
Excel(エクセル)
-
8
エクセルVBAで画像を貼り付ける座標設定方法は?
PowerPoint(パワーポイント)
-
9
エクセルのシートに貼りつけたbmpをjpegに
その他(Microsoft Office)
-
10
Excelに貼り付けた画像を圧縮するマクロについて
Visual Basic(VBA)
-
11
GDI+を使ったビット数とDPIの扱い
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
phpで画像がどうしても文字化け...
-
透過PNGが透過されない!!
-
imageフォルダに、画像をリサイ...
-
ファイルアップロードのダイア...
-
Illustratorで文字と画像を流し...
-
BLOBデーターの画像の表示方法...
-
アップロード画像数でCSSを分け...
-
phpで画像を保存するときにリサ...
-
phpMyAdminに画像を保存できない
-
libpngでpng操作がうまくいかない
-
PHPで吐き出した画像にリンクを...
-
VBSの「MsgBox」について
-
最も速い画像合成処理を教えて...
-
phpについて
-
onedrive にexcelファイルをア...
-
フォントの色を変えるには?
-
バッチを用いたフォルダの自動移動
-
phpとaspの違いについて
-
form actionで二つ送信先を指定...
-
PHP8を使うと、大量のWarningが...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBSの「MsgBox」について
-
拡張子php画像をjpg画像等に変...
-
透過PNGが透過されない!!
-
Illustratorで文字と画像を流し...
-
アップロード画像数でCSSを分け...
-
imageフォルダに、画像をリサイ...
-
PythonのTkinter詳しい方へ。画...
-
VBAでJPGサイズ変更
-
C# Excelファイルへの画像挿入。
-
ListViewコントロールでサムネ...
-
PHPで吐き出した画像にリンクを...
-
php,mysqlにて画像パス保存/表...
-
PHP+PostgreSQLを使ってPDFファ...
-
スマートフォンから画像のアッ...
-
画像にテキストを埋め込むジェ...
-
実行ファイル(exe)に画像ファ...
-
ビットマップ画像を読み込むプ...
-
改行コードのカウント
-
Ajaxで画像表示
-
画像アップロードのファイル名...
おすすめ情報