VBA - ユーザーフォームのLoadpicture（）にサムネイルを作成

Question

Userformの複数のImageコントロールの画像をLoadpicture()を使用して読み込んで、いくつかのプレビューを作成しています。 （ユーザーはImageをクリックしてフルサイズの画像を開くことができます）。

UserformのプレビューImageは1cm程度背が高いので、まだフルサイズ（メガピクセル）上のソース画像を維持しながら、私は、メモリ使用量を制限するために画像のサムネイル（小さいファイルサイズバージョン）をロードしたいと思いハードドライブ。

ロードイベントでインポートされた画像のサイズを変更する方法はありますか？

PS：PictureSizeModeがfmPictureSizeModeZoomに設定されているため、画像の可視の高さ/幅を変更しようとしていません。

Answer 1

周りハック - yの方法がこれを行うにはあります - 基本的には：

• は、形状を作成して画像を読み込むと
• 画像のサイズを変更し、一時Worksheet
• を作成一時を作成Chartサイズ変更した画像を貼り付けてください。
• Chartをテンポラリファイルにエクスポートする
• テンポラリを削除するWorksheet
• 負荷の一時ファイルUserForm
• にそれは少し恐ろしいですが、それが動作一時ファイル

を削除します。コードが実行されている間にApplication.ScreenUpdating = Falseを使用することを検討したいかもしれませんが、以下のコードを実行してその動作を確認すると便利です。

Option Explicit 

Private Sub UserForm_Initialize() 

    ' size of thumbnail 
    Dim lngSide As Long 
    lngSide = 50 

    ' input jpg and temp file path 
    Dim strInPath As String 
    Dim strOutPath As String 
    strInPath = Environ("USERPROFILE") & "\Desktop\Capture.JPG" 
    strOutPath = Environ("USERPROFILE") & "\Desktop\temp.JPG" 

    ' add a temp worksheet 
    Dim ws As Worksheet 
    Set ws = ThisWorkbook.Sheets.Add 

    ' load picture to shape and RESIZE 
    Dim shp As Shape 
    Set shp = ws.Shapes.AddPicture(Filename:=strInPath, _ 
     LinkToFile:=msoFalse, _ 
     SaveWithDocument:=msoCTrue, _ 
     Left:=20, _ 
     Top:=20, _ 
     Width:=lngSide, _ 
     Height:=lngSide) 

    ' create a chart 
    Dim cht As Chart 
    Set cht = ws.Shapes.AddChart(xlColumnClustered, _ 
     Width:=lngSide, _ 
     Height:=lngSide).Chart 

    ' copy shape picture to chart and export to temp file 
    shp.Copy 
    cht.Paste 
    cht.Export Filename:=strOutPath, FilterName:="jpg" 

    ' remove temp sheet (including shape and chart) with no alerts 
    Application.DisplayAlerts = False 
    ws.Delete 
    Application.DisplayAlerts = True 

    ' load resized temp picture to image control 
    With Me.Image1 
     .Height = lngSide 
     .Width = lngSide 
     .Picture = LoadPicture(strOutPath) 
    End With 

    ' delete the temp file 
    Kill strOutPath 

End Sub