UserForm a alınan resmin boyutunu ayarlamak

[halit3]

Koda bakınca kırmızı yerin olmadığı anlaşılıyor unutulmuş bunu sizde yapabilirsiniz

dosya = ActiveWorkbook.Path & "\TK_Foto\" & [A1]

Private Sub UserForm_Initialize()
Dosya = Application.GetOpenFilename("All Files (*.*),*.*.")
If Dosya = False Then
MsgBox "Dosya seçme işlemini yapmadınız.", vbInformation, "DİKKAT"
Exit Sub
Else
End If

gen = 500
yuk = 515

Dim Img As Object, IP As Object, fL As Object

Set IP = CreateObject("WIA.ImageProcess")
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile Dosya

IP.Filters.Add IP.FilterInfos("Scale").FilterID
If gen <> 0 Then IP.Filters(1).Properties("MaximumWidth") = gen
If yuk <> 0 Then IP.Filters(1).Properties("MaximumHeight") = yuk

IP.Filters(1).Properties("PreserveAspectRatio") = False

Set Img = IP.Apply(Img)

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID") = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"

Set fL = CreateObject("Scripting.FileSystemObject")

aranan2 = fL.GetParentFolderName(Dosya) & "\resim13.JPG"
Img.SaveFile aranan2

Me.Picture = LoadPicture("")
Me.Picture = LoadPicture(aranan2)
Kill aranan2
Error_Handler_Exit:

End Sub

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Daha önce baktığımda fark etmemişim. Yordum sizi. Çok teşekkür ederim.
Saygılarımla