Userforma belirli alanın resmini yapıştırmak

[Korhan Ayhan]

@Tevfik_Kursun,

#5 nolu mesajımda ki dosyada küçük bir değişiklik yaptım. Tekrar deneyip sonucu bildirir misiniz?

 

[halit3]

png uzantılı kodu birazcık daha sadeleştirdim.

Private Sub CommandButton5_Click()

Dim aranan1 As String
Dim bulunan1 As String

Dim oWIA As Object
Dim oIP As Object
Dim sFormatID As String

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

aranan1 = a
bulunan1 = fL.GetParentFolderName(a) & "\" & fL.GetBaseName(a) & "aa.JPG"

sFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Set oWIA = CreateObject("WIA.ImageFile")
Set oIP = CreateObject("WIA.ImageProcess")

oIP.Filters.Add oIP.FilterInfos("Convert").FilterID
oIP.Filters(1).Properties("FormatID") = sFormatID

oWIA.LoadFile aranan1
Set oWIA = oIP.Apply(oWIA)
'Overide the specified ext with the appropriate one for the choosen format
oWIA.SaveFile bulunan1
UserForm4.Picture = LoadPicture("")
UserForm4.Picture = LoadPicture(bulunan1)
Kill bulunan1
UserForm4.Show 0
End Sub

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
Hata mesajı değişti.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
png uzantılı dosyayı yükledi. İlginize çok teşekkür ederim. png dosyayı ikinci resim olarak yükleyebilecek miyim. Bu şansım olacak mı? Olmayacaksa yorulmayın. Ama userform içine jpg resim almak bile benim için farklı bir deneyim oldu. Userform da farklı alternatiflerin olduğunu da gördüm.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Tahmin etmiştim. İlginize çok teşekkür ederim.
Saygılarımla

 

[Korhan Ayhan]

@Tevfik_Kursun,

#5 nolu mesajımda ki dosyayı tekrar revize ettim. Tekrar dener misiniz?

 

[Haluk]

Tevfik Bey, ben yine ufak bir bilgi vereyim ....

Merak ettiğim için, Halit Beyin 102 No'lu mesajındaki kodları denedim ama; PNG formatını JPG'e çevirip UserForm'a yüklediği için benim 97 No'lu mesajda kullandığım saydam PNG'lerin arka planları saydam değil, "siyah" olarak çıktı. Sizde durum nedir bilemiyorum tabii....




.

 

[Tevfik_Kursun]

Sayın Korhan Ayhan Hocam,
Çalıştı. Elinize sağlık.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Doğru, jpg e çeviriyor. bir resmin üzerine getirtemediğim için saydam olup olmadığı anlaşılmıyor. Bildiğim kadarıyla jpg dosya saydam olmuyor. Kodlara baktım, jpg yaptığını orada gördüm.
Saygılarımla

 

[Haluk]

Doğru, jpg e çeviriyor. bir resmin üzerine getirtemediğim için saydam olup olmadığı anlaşılmıyor. .....
.....

Arka plan "siyah" ise, saydam değil demektir ......

.

 

[Tevfik_Kursun]

Sayın Halit3 Hocam,
Son koyduğunuz makro da çalışıyor. Bundan öncekinde zemin beyaz gelmişti, şimdi her ikisinde de siyah geliyor. Şart değil iki resmin üt üste gelmesi. Ben yeniden hazırlık yaparım. Jpg gelmesi yeterli. Hepinize ayrı ayrı teşekkür ederim. Sizlerin çalışma aşkı benim daha da zevkle çalışmamı sağlıyor. Bunun içinde ayrıca teşekkür ederim.
Saygılarımla

 

[halit3]

Genişlik ve yükseklik olarak da ekliyorum png uzantılı resim için
kodu bir userform içine koyun ve formu açın

Private Sub UserForm_Initialize()

Dim aranan1 As String
Dim bulunan1 As String
Dim uzanti As String

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

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

aranan1 = a
bulunan1 = fL.GetParentFolderName(a) & "\" & fL.GetBaseName(a) & "aa.JPG"

Dim Img As Object, IP As Object
Set IP = CreateObject("WIA.ImageProcess") 'create WIA objects
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile aranan1 'load image

IP.Filters.Add IP.FilterInfos("Stamp").FilterID
Set IP.Filters(1).Properties("ImageFile") = Img

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

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID") = uzanti
Set Img = IP.Apply(Img)
Img.SaveFile bulunan1
Me.Picture = LoadPicture("")
Me.Picture = LoadPicture(bulunan1)

Me.Height = Img.Height
Me.Width = Img.Width


Kill bulunan1

End Sub

 

[Tevfik_Kursun]

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

 

[Haluk]

@Tevfik_Kursun Bey, 97 No'lu mesajda bahsettiğim gibi, transparan/saydam PNG formatındaki resimlerin görüntülenmesine ilişkin dosya (32/64 Bit Excel) ekte verilmiştir.

İlave edeceğim 1-2 husus daha olduğu için, henüz geliştirme aşamasındadır, fikir vermesi için bu haliyle ekledim.


.

 

[Tevfik_Kursun]

Günaydın Sayın Haluk Hocam,
Öğrenmek için diyorsanız lafım yok, ama benim için uğraşmayın lütfen.
Saygılarımla

 

[Muhammet Okumuş]

@Tevfik_Kursun Bey, 97 No'lu mesajda bahsettiğim gibi, transparan/saydam PNG formatındaki resimlerin görüntülenmesine ilişkin dosya (32/64 Bit Excel) ekte verilmiştir.

İlave edeceğim 1-2 husus daha olduğu için, henüz geliştirme aşamasındadır, fikir vermesi için bu haliyle ekledim.


.

Güzel bir çalışma olmuş Haluk Bey.