UserForm a alınan resmin boyutunu ayarlamak

[halit3]

Resmin boyutu çok küçük bu resim büyükdükçe görüntü mutlaka bozulacaktır.
örnek olarak 640-480 dönüştürdümmüydü görün bozuluyor.

 

[Tevfik_Kursun]

Sayın Hali3 Hocam,
paint.net programında pixel olarak resimdeki değerleri veriyor. Önemli değil siz bu haliyle gösterin ben bir çalışma yaparım. İlginiz için çok teşekkür ederim.
Saygılarımla

 

[halit3]

bu eklediğiniz resmin boyutları bu 131-76

benim eklediğim resim ölçüleri 640-480

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Benim dosya. İncelediğinizde ne düşündüğümü daha iyi anlayacaksınız.
Saygılarımla

 

[halit3]

userformun genişlik ve yükseklik ölçüleri ne olacak.

 

[Tevfik_Kursun]

Gönderdiğim örneğe baktınız mı, sayın hocam?
Sadece uygun olsun yeterli.
Saygılarımla

 

[halit3]

örnek dosyanızdaki userformun ölçüleri 414-387

 

[Tevfik_Kursun]

Bu haliyle resim, oldukça temiz ve userformdan büyük görünüyor. Ekli resimdeki kırmızı bölge bu userformda görünmüyor. Bütün sıkıntım bu.
Saygılarımla

 

[halit3]

bu resmi userforma manuel yükle ve o dosyayıda buraya ekle bir bakalım veya bu resmi rar olarak sıkıştır buraya yükle

 

[Tevfik_Kursun]

Yükleyip kayıt yaptığımda dosyayı açtığımda userform kapanmış oluyor. O nedenle ekran görüntüsünü koydum.
Saygılarımla

 

[halit3]

bu resmi winrar içine koy buraya ekle

 

[halit3]

23 mesaja ben rarlı bir dosya ekledim onun gibi buraya ekleyiniz.

 

[Tevfik_Kursun]

Buyrun Sayın Hocam
Saygılarımla

 

[halit3]

bu dosyayı bir dene

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Bu daha iyi, sanırım olacağı da bu. Elinize sağlık. Tekrar teşekkür ederim. Ama bunu önceki gibi otomatik çağırabileceğim hale çevirir misiniz?
Saygılarımla

 

[Tevfik_Kursun]

Dosya adını A1 den alacak şekilde olursa işe yarar.
Saygılarımla

 

[halit3]

formdaki açılış kodu bununla değiştir.

Private Sub UserForm_Initialize()


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

Dim aranan2 As String
Dim aranan1 As String
Dim fformat As String
Dim gen As Long
Dim yük As Long

aranan1 = yol
aranan2 = yol
fformat = "JPG"
gen = 500
yük = 515

Dim ters As Boolean
ters = False
Call imgResizeH(aranan1, aranan2, gen, yük, fformat, ters) ' False)' False)
End Sub

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
İlginize çok teşekkür ederim.
Saygılarımla

 

[halit3]

kodu sadeleştirdim userformdaki kodların hepsini silin bunları ekleyiniz.

Private Sub CommandButton1_Click()
Dosya = ActiveWorkbook.Path & "\TK_Foto\" & [A1]

gen = 500
yuk = 515

Dim fL As Object
Dim Img As Object, IP As Object
Dim sFormatID As String
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)

sFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID") = sFormatID

Set fL = CreateObject("Scripting.FileSystemObject")
sat = fL.GetFolder(fL.GetParentFolderName(Dosya)).Files.Count + 1

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

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

End Sub

Private Sub UserForm_Initialize()
CommandButton1_Click
End Sub

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Bu hatayı verdi.
Saygılarımla