Userform ımage

[zulfuernek]

http://dosya.co/76u0nrt0kqna/USERFORM_ARKA_PLAN_DEĞİŞTİRME_1_(COMMAND_BUTTON_).xlsm.html


yukarıdaki linkle userform arkaplanı istediğim dosyadan rasgele ekleyebiliyorum. fakat userformu kapatıp açınca resim gidiyor. eklediğim ımage ile tekrar açılması için kodda nasıl bir değişiklik yapabiliriz.

 

[Saban Sertkaya]

Merhabalar,

Resmin yolunu bir hücreye yazdırıp, tekrar oradan çek edebilirsiniz.
Aşağıdaki şekilde deneyeniz.

Private Sub Label1_Click()
[COLOR="Red"]If [A1] <> "" Then Me.Picture = LoadPicture([A1])[/COLOR]
ChDir ("C:\")
resim = Application.GetOpenFilename(FileFilter:="," & _
        "*.jpg", _
        Title:=" LÜTFEN RESİM SEÇİMİ YAPINIZ .")
[COLOR="red"][A1] = resim[/COLOR]
    If resim = False Then
        Exit Sub
    Else
        Me.Picture = LoadPicture(resim)
        End If
End Sub
[COLOR="red"]
Private Sub UserForm_Activate()
If [A1] <> "" Then Me.Picture = LoadPicture([A1])
End Sub[/COLOR]

 

[zulfuernek]

saban hocam emeğinize sağlık oluyor. fakat örnek vereyim resmi bilgisayardan silince userform hata verecektir.
Dosya yolu yerine resmin kendisini, örnek vereyim; "SYSTEM" sayfası içinde "A1" hücresine kaydetsin ve orada boyutlandırsın ki excelin boyutu artmasın.

 

[Saban Sertkaya]

Merhabalar,

- Resmi sildiğinizde hata almak istemiyorsanız, "On Error Resume Next" komutunu kullanabilirsiniz.

- Eğer resmi excelin içine gömerseniz, excelin dosya boyutu büyür. Boyut, resmin ebatından ziyade formatıyla alakalı olacaktır. Yani .bmp, .jpg, .png gibi...

Arka plan resmini sürekli değiştirmeseniz olmaz mı ?

Userformun "Picture" özelliğine resim tanımlayarak (kod yazmadan) istediğinizi sağlayabilirsiniz. Üstelik resmi silseniz bile, ne hata alırsınız, ne de resim kaybolur. Örnek dosyada userform üzerinde ekli olan resim sizin bilgisayarınızda kayıtlı olmamasına rağmen, resmi görüyor olmalısınız. Dosyayı indirip bakınız.

http://dosya.co/wrg61mnot9us/Userform_Resim.rar.html

 

[zulfuernek]

yok saban hocam. dediğinizde haklısıznız fakat o yol pek işimi görmemekte. bu yüzden bu yola başvuruyorum. ben bi formül buldum. resimn boyutunuda küçltüyor. fakat belli bir dosya için. ama ben belli bir dosyadan değilde bilgisayarda kayıtlı bir resmi eklemek istiyorum.



ActiveSheet.Pictures.Insert("C:\Users\Elazığ\Pictures\flower.jpg").Select
Selection.ShapeRange.ScaleWidth 0.0269359938, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.0269360269, msoFalse, msoScaleFromTopLeft

aktif sekmenin a1 hücresine eklemek istiyorum

 

[Orion1]

Buyurun.

Sub resim59()
Dim resim As Object
Range("A1").Select
    'Range("A1").Select
    Set resim = ActiveSheet.Pictures.Insert("C:\Users\Elazığ\Pictures\flower.jpg")
    'En Boy Oranı Sabit Değil.İstediğimiz Boyut Veriliyor.
    'Dikkat Boyut cm Değil İnç
    'EnBoy oranı sabit olmasını istiyorsak msoFalse Yerine msoTrue yazılacak
    resim.ShapeRange.LockAspectRatio = msoFalse
    resim.ShapeRange.Height = Range("A1").Height
    resim.ShapeRange.Width = Range("a1").Width
    'Range("A5").Select
End Sub

 

[Ömer BARAN]

Sayın saban20152015'in uyarısı dolayısıyla cevabımı ....sildim.....

 

[Saban Sertkaya]

2.mesaja bakın Ömer Bey.

 

[Ömer BARAN]

Merhaba.
Haklısınız Sayın saban20152015.
Fark etmemişim, şimdi cevabımı siliyorum.

 

[zulfuernek]

Orion hocam ve ömer hocam bunlarda problem yok benim amcım sabit bir klasörden seçmemesi. yani bilgisayarda kaytlı herhengi bir konumdan resmi seçmektir

ActiveSheet.Pictures.Insert("C:\Users\Elazığ\Pictu res\flower.jpg").Select
Selection.ShapeRange.ScaleWidth 0.0269359938, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.0269360269, msoFalse, msoScaleFromTopLeft

kırmızı alanın sabit değilde bilgisayarda kayıtlı herhangi bir konumdaki herhengi bir resim olmasını istiyorum

 

[zulfuernek]

saban hocam dosya yolu olsun istemiyorum. onun haricinde kodlama tam istediğim gibi. ölçülendirmesi felan

Dim resim As Object
Range("A1").Select
'Range("A1").Select
Set resim = ActiveSheet.Pictures.Insert("C:\Users\Elazığ\Pictures\flower.jpg")
'En Boy Oranı Sabit Değil.İstediğimiz Boyut Veriliyor.
'Dikkat Boyut cm Değil İnç
'EnBoy oranı sabit olmasını istiyorsak msoFalse Yerine msoTrue yazılacak
resim.ShapeRange.LockAspectRatio = msoFalse
resim.ShapeRange.Height = Range("A1").Height
resim.ShapeRange.Width = Range("a1").Width
'Range("A5").Select

 

[Orion1]

saban hocam dosya yolu olsun istemiyorum. onun haricinde kodlama tam istediğim gibi. ölçülendirmesi felan

Dim resim As Object
Range("A1").Select
'Range("A1").Select
Set resim = ActiveSheet.Pictures.Insert("C:\Users\Elazığ\Pictures\flower.jpg")
'En Boy Oranı Sabit Değil.İstediğimiz Boyut Veriliyor.
'Dikkat Boyut cm Değil İnç
'EnBoy oranı sabit olmasını istiyorsak msoFalse Yerine msoTrue yazılacak
resim.ShapeRange.LockAspectRatio = msoFalse
resim.ShapeRange.Height = Range("A1").Height
resim.ShapeRange.Width = Range("a1").Width
'Range("A5").Select

kimin hangi cevabı verdiğini şaşırdınız sanırım.
Dosya yolunu nereden alsın?

 

[zulfuernek]

Orion hocam dosya yolunu sabit bir dosyadan değilde. bilgisayarda kayıtlı herhangi bir dosya içerisinden seçmek istiyorum. herhangi bir dosya içerisinde herhangi bir JPEG resmini )

 

[Orion1]

Orion hocam dosya yolunu sabit bir dosyadan değilde. bilgisayarda kayıtlı herhangi bir dosya içerisinden seçmek istiyorum. herhangi bir dosya içerisinde herhangi bir JPEG resmini )

Şaban beyin,2# mesajda yaptığı gibi olurmu?Çıkan pencereden bir klasör içinden almak gibi.

 

[zulfuernek]

aynen hocam. 2# mesajda sayın saban hocamın emeğine saplık büyük bir sorunu çzödü ama o sadece dosya yolunu kopyalıyor. benim amacım dosya yolunu değilde resmi bırakması. fakat sabit bir dosyadan değilde "get open filename" ile

 

[zulfuernek]

http://dosya.co/7jvaslf2zfyy/DOSYA_AÇMA_MAKROSU.xlsm.html

örnek dosya

 

[Orion1]

Buyurun.

Sub resim59()
Dim resim As Object, x
Range("A1").Select
ChDir ("C:\")
x = Application.GetOpenFilename(filefilter:="Resim Dosyaları,*.jpg", Title:="RESİM DOSYASINI SEÇİN")
If x = False Then MsgBox "Resim dosyası seçilmedi!!", vbCritical, "UYARI": Exit Sub
Set resim = ActiveSheet.Pictures.Insert(x)
'En Boy Oranı Sabit Değil.İstediğimiz Boyut Veriliyor.
'Dikkat Boyut cm Değil İnç
'EnBoy oranı sabit olmasını istiyorsak msoFalse Yerine msoTrue yazılacak
resim.ShapeRange.LockAspectRatio = msoFalse
resim.ShapeRange.Height = Range("A1").Height
resim.ShapeRange.Width = Range("a1").Width
'Range("A5").Select
End Sub

 

[zulfuernek]

Orion hocam şakamı bu )

 

[Orion1]

Orion hocam şakamı bu )

Anlamadım.Olmamışmı?

 

[zulfuernek]

ya olmamışmı ne kelime Orion hoam inanın hayran kaldım. )))
uzun zamandır aradığım bişeydi. bende bi ekleme yaptım lşimdi. kodların en üstüne syfada resim varsa sil dedim. varsa önce siliyor. sonrada yeni resmi bırakıyor.

ufak bir ekleme daha istiycem. şimdide aktif sayfada ki resmi userform arka planı nasıl yapıcaz ))



Private Sub CommandButton1_Click()
ActiveSheet.DrawingObjects.Delete ‘RESİM VARSA ÖNCE VAR OLAN RESMİ SİL
Dim resim As Object, x
Range("A1").Select
ChDir ("C:\")
x = Application.GetOpenFilename(FileFilter:="Resim Dosyaları,*.jpg", Title:="RESİM DOSYASINI SEÇİN")
If x = False Then MsgBox "Resim dosyası seçilmedi!!", vbCritical, "UYARI": Exit Sub
Set resim = ActiveSheet.Pictures.Insert(x)
'En Boy Oranı Sabit Değil.İstediğimiz Boyut Veriliyor.
'Dikkat Boyut cm Değil İnç
'EnBoy oranı sabit olmasını istiyorsak msoFalse Yerine msoTrue yazılacak
resim.ShapeRange.LockAspectRatio = msoFalse
resim.ShapeRange.Height = Range("A1").Height
resim.ShapeRange.Width = Range("a1").Width
'Range("A1").Select



End Sub