• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Userform ımage

Merhabalar,

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

Kod: 
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]
 
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.
 
Son düzenleme:
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
 
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
 
Buyurun.:cool:
Kod: 
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
 
Sayın saban20152015'in uyarısı dolayısıyla cevabımı ....sildim.....
 
Merhaba.
Haklısınız Sayın saban20152015.
Fark etmemişim, şimdi cevabımı siliyorum.
 
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
 
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
 
zulfuernek' Alıntı:
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
Genişletmek için tıkla ...
kimin hangi cevabı verdiğini şaşırdınız sanırım.
Dosya yolunu nereden alsın?:cool:
 
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 :))
 
zulfuernek' Alıntı:
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 :))
Genişletmek için tıkla ...

Şaban beyin,2# mesajda yaptığı gibi olurmu?Çıkan pencereden bir klasör içinden almak gibi.:cool:
 
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
 
Buyurun.:cool:

Kod: 
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
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst