VBAで、GDI+を使って画像を回転させるには? (ID:141076)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

エクセルのVBAで、GDI+を使って画像を回転、リサイズしてワークシートに貼付ようとしています。
海外サイトで下記のコード（元がVB6用のため若干修正）を見つけたのですが、回転により元画像のサイズからはみ出す部分は切れてしまいます。Graphicsオブジェクトのサイズを変更してやれば良いと考えたのですが、方々いじったり、サイズの大きいビットマップから作成したGraphicsとすげ替えてみたりと、試行錯誤はしてみたのですが無理でした。御教示いただきたく、お願いします。GraphicsとImageは連動している様ですが、そのあたりは良く理解できておりません。なお、リサイズの方は（自力ではありませんが）出来ております。
Public Function RotateImage(ByRef hImage As Long, ByVal angle As Single, Optional lBackColour As Long = -1)
    Dim retval As Long
    Dim hGraphics As Long
    Dim hClone As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim hBrush As Long
    
    retval = GdipGetImageHeight(hImage, lHeight)
    retval = GdipGetImageWidth(hImage, lWidth)
    If angle > 0 And angle < 360 Then angle = angle - 180
    '元画像(Image）のクローンを作成
    retval = GdipCloneImage(hImage, hClone)
    '元画像(Image)から、Graphicsオブジェクトを生成
    retval = GdipGetImageGraphicsContext(hImage, hGraphics)
    If lHeight <> lWidth Then
        retval = GdipCreateSolidFill(lBackColour, hBrush)
        retval = GdipFillRectangle(hGraphics, hBrush, 0, 0, lWidth, lHeight)
        retval = GdipDeleteBrush(hBrush)
    End If
    retval = GdipRotateWorldTransform(hGraphics, angle, MatrixOrderPrepend)
    retval = GdipTranslateWorldTransform(hGraphics, lWidth / 2, lHeight / 2, MatrixOrderAppend)
    retval = GdipDrawImageRectI(hGraphics, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
'Graphicsオブジェクトに元画像のコピーを描画
    'retval = GdipDrawImageRectI(pGraphicsDesktop, hClone, lWidth / 2, lHeight / 2, -lWidth, -lHeight)
    retval = GdipDeleteGraphics(hGraphics)
    retval = GdipDisposeImage(hClone)
End Function

←解決時は質問者本人がここをチェックしてください。

戻る