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.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.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も見ています
-
外出時に「待たせる妻」vs イライラする「待つ夫」は日本だけ?見習いたい海外事情
夫の家事参加に積極的なイメージのある海外でも、同様の事例はあるのか。結婚カウンセラーの佐竹悦子さんに伺ってみた。
-
エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、
Excel(エクセル)
-
VBAで画像圧縮はできますか?
Visual Basic(VBA)
-
Excel マクロ 画像をリンクせずかつ圧縮して貼りつける方法を教えてください
Excel(エクセル)
-
-
4
VBAにGDI+を参照させる方法
Visual Basic(VBA)
-
5
bmp画像をjpegやpng画像に圧縮する方法
Visual Basic(VBA)
-
6
Excelに貼り付けた画像を圧縮するマクロについて
Visual Basic(VBA)
-
7
エクセルでエラーが出て困っています。
Excel(エクセル)
-
8
オートシェイプをJPG保存
Visual Basic(VBA)
-
9
GDI+を使ったビット数とDPIの扱い
Visual Basic(VBA)
-
10
エクセルのシートに貼りつけたbmpをjpegに
その他(Microsoft Office)
-
11
画像をトリミングしてフォルダに保存をvbaで
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
拡張子php画像をjpg画像等に変...
-
どの画像がクリックされたかフ...
-
実行ファイル(exe)に画像ファ...
-
VBSの「MsgBox」について
-
GDI+を使ったビット数とDPIの扱い
-
C# Excelファイルへの画像挿入。
-
VBAでJPGサイズ変更
-
携帯電話から画像ファイルをア...
-
pythonのファイル内に 手書き数...
-
ウィンドウサイズを取得して、p...
-
画像が存在しない時の 「×」 表...
-
10進BASICでの画像回転
-
MYSQLから、画像表示するには
-
アップロード画像数でCSSを分け...
-
ビットマップ画像を読み込むプ...
-
pictureboxに表示した画像のフ...
-
onedrive にexcelファイルをア...
-
こちらはただの直列処理ですか?
-
ワードプレス、Contact Form 7...
-
PHPとCSVで簡易データベースな...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBSの「MsgBox」について
-
拡張子php画像をjpg画像等に変...
-
透過PNGが透過されない!!
-
アップロード画像数でCSSを分け...
-
imageフォルダに、画像をリサイ...
-
VBAでJPGサイズ変更
-
Illustratorで文字と画像を流し...
-
VBAのコードを教えてください
-
C# Excelファイルへの画像挿入。
-
php,mysqlにて画像パス保存/表...
-
GDI+を使ったビット数とDPIの扱い
-
SQLiteに画像を格納したい
-
ListViewコントロールでサムネ...
-
★PHP?★画像を縦横比を変えずに...
-
ビットマップ画像を読み込むプ...
-
phpで画像がどうしても文字化け...
-
PHPで吐き出した画像にリンクを...
-
phpMyAdminに画像を保存できない
-
OpenGLで描いて画像ファイル出力
-
手作業で埋め込んだ、UserForm1...
おすすめ情報