• DİKKAT

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

Listboxtan Texboxlara veri ve forma resim çağırma

  • Konbuyu başlatan Konbuyu başlatan Galus
  • Başlangıç tarihi Başlangıç tarihi
Resmi otomatik boyutlandırma ve sıkıştırma

Selamlar,

Ekteki dosyaya resim ekleme butonu ekledim fakat resim eklendiğinde örnekte gördüğünüz formdaki çerceveye göre otomatik olarak boyutlandırabilirmiyiz? Daha sonrada resimlerin boyutları 2 mb ve üzeri olduğu için resimleri "compress pictures" ile sıkıştırıyoruz bunun içinde buton ekleme şansımız olabilirmi?

Yardmlarınızı ve önerileriniz rica ederim.

teşekkürler.
 

Ekli dosyalar

3 adet Sheet1 sayfasına optionbutton ekle ve sayfanın modül sayfasına aşağıdaki kodu yapıştır


Kod: 
Private Sub CommandButton2_Click()
'On Error Resume Next
Ekle_Nesne_IstedigimiSil
ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=128.75, Top:=255.75, Width:=560.15, Height:=447.75).Select
End Sub
 
Private Sub RESIMEKLE_Click()
Dim fichImg
fichImg = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
, , "Choix de l'image.1", , False) 'false selection simple
'If fichImg = False Then Exit Sub
'ActiveSheet.Pictures.Insert(fichImg).Select
On Error Resume Next
Sheets(ActiveSheet.Name).Image1.Picture = LoadPicture(fichImg)
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Sub Ekle_Nesne_IstedigimiSil()
Dim Picture As Object
Dim Bak As String
Dim Uzunluk As Byte
'Bak = InputBox("Hangi Türdeki Resim Silinecek?", " HALİT ", "Image")
Bak = "Image"
Uzunluk = Len(Bak)
For Each Picture In ActiveSheet.Shapes
If Mid(Picture.Name, 1, Uzunluk) = Bak Then
Picture.Delete
End If
Next Picture
End Sub
Private Sub OptionButton1_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeClip
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Private Sub OptionButton2_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeStretch
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Private Sub OptionButton3_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeZoom
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
 
Son düzenleme:
Hata!

halit3' Alıntı:
3 adet Sheet1 sayfasına optionbutton ekle ve sayfanın modül sayfasına aşağıdaki kodu yapıştır


Kod: 
Private Sub CommandButton2_Click()
'On Error Resume Next
Ekle_Nesne_IstedigimiSil
ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=128.75, Top:=255.75, Width:=560.15, Height:=447.75).Select
End Sub

Private Sub RESIMEKLE_Click()
Dim fichImg
fichImg = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
, , "Choix de l'image.1", , False) 'false selection simple
'If fichImg = False Then Exit Sub
'ActiveSheet.Pictures.Insert(fichImg).Select
On Error Resume Next
Sheets(ActiveSheet.Name).Image1.Picture = LoadPicture(fichImg)
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Sub Ekle_Nesne_IstedigimiSil()
Dim Picture As Object
Dim Bak As String
Dim Uzunluk As Byte
'Bak = InputBox("Hangi Türdeki Resim Silinecek?", " HALİT ", "Image")
Bak = "Image"
Uzunluk = Len(Bak)
For Each Picture In ActiveSheet.Shapes
If Mid(Picture.Name, 1, Uzunluk) = Bak Then
Picture.Delete
End If
Next Picture
End Sub
Private Sub OptionButton1_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeClip
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Private Sub OptionButton2_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeStretch
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Private Sub OptionButton3_Click()
Sheets("Sheet1").Image1.PictureSizeMode = fmPictureSizeModeZoom
Sheets("Sheet1").Image1.Visible = False
Sheets("Sheet1").Image1.Visible = True
End Sub
Genişletmek için tıkla ...

kodu aynen yapıştırdım fakat hata verdi, ben ingilizce office kullanıyorum bundan kaynaklanıyor olabilirmi?
 
dosyayı gönderdim dosyaya bak

önce resim tablosu oluştur düğmesine tıkla
sonra resim ekle
 
Evet haklısın Halit Karderş oldu fakat ufak bir sorun var, resmi tam görüntüsüyle küçültemedim ve bu resmi başka bir yere mail atacağım için mail attığım kişi resmi nasıl kayıt edebilir?
 
Peki "compress pictures" resim sıkıştırma için buton yapmak mümkün olabilirmi?
 
Teşekkürler

Hakan_S' Alıntı:
Peki "compress pictures" resim sıkıştırma için buton yapmak mümkün olabilirmi?
Genişletmek için tıkla ...

Kusura bakmayın,işlerimin yoğunluğu yüzünden girmeye pek fırsatım olmadığı için Teşekkür edemedim.

Yaptığınız çalışma için teşekkür ederim. Geçmiş Bayramınız mübarek olsun.
 
resimi sıkıstırma

Sub Compress_PIX()

Dim octl As CommandBarControl

ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 185
Selection.ShapeRange.Width = 210#
Selection.ShapeRange.Rotation = 0#



With Selection
Set octl = Application.CommandBars.FindControl(ID:=6382)
Application.SendKeys "%w~"
Application.SendKeys "%a~"
octl.Execute
End With

End Sub





yukarıdaki kodu
http://vbadud.blogspot.com/2010/05/how-to-compress-pictures-in-excel-using.html

bu adresten buldum birazını da kendim tamamladım excel 2003 ingilizce de çalışıyor. umarım birilerinin işine yarar

resim boyutlarını rast gele verdim herhangi bir olculendir me yok
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst