ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[alooo]

Merhaba,
X sayfasının A1:C10 hücrelerinin resmini alarak, oluşturulan userform Image nesnesi içinde gösterilmesini nasıl sağlayabiliriz?

Belirli kısmın resmini alıp, sayfa içinde C11 hücresine, "ResimX" adı ile kopyalıyorum ancak, image nesnesi içinde gösterimini sağlayamıyorum. (Resmin bir klasör içinde olmadığını ve sürekli olarak değişen verilera ait resim olduğunu belirtmek isterim.)
Bu hususta yardımcı olursanız sevinirim.

[alooo]

Durum günceldir.

Yardımlarınızı talep ederim.

[alooo]

Yardım edebilecek arkadaş yok mu acaba?
(Durum güncelliğini belirtmek amacı ile yazılmıştır.)

[erseldemirel2]

Userform açılıp bir adet butona bu kodu ekleyip çalışmasını kontrol ediniz. Küçük notlar ekledim

Kod: Tümünü seç

Private Sub CommandButton1_Click()
Range("A1:C10").Copy 'GÖRÜNTÜ ALINAN YER
Range("H4").Select 'GEÇİCİ YER DEĞİŞTİRİLEBİLİR
ActiveSheet.Pictures.Paste Link:=True
ActiveSheet.Pictures.Select
Application.CutCopyMode = False
Dim tChart As String, tPicture As String
Dim imgWidth As Long, imgHeight As Long
Application.ScreenUpdating = False
tPicture = Selection.Name
With Selection
imgHeight = .ShapeRange.Height
imgWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa1" 'Type your Sheet Name
Selection.Border.LineStyle = 0
tChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
With .Shapes(tChart)
.Width = imgWidth
.Height = imgHeight
End With
.Shapes(tPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="D:\MyPic.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR
.Shapes(tChart).Cut
End With
Application.ScreenUpdating = True
Set Picture = LoadPicture("D:\MyPic.jpg")
ActiveSheet.Pictures.Delete
End Sub


[alooo]

Userform açılıp bir adet butona bu kodu ekleyip çalışmasını kontrol ediniz. Küçük notlar ekledim

Kod: Tümünü seç

Private Sub CommandButton1_Click()
Range("A1:C10").Copy 'GÖRÜNTÜ ALINAN YER
Range("H4").Select 'GEÇİCİ YER DEĞİŞTİRİLEBİLİR
ActiveSheet.Pictures.Paste Link:=True
ActiveSheet.Pictures.Select
Application.CutCopyMode = False
Dim tChart As String, tPicture As String
Dim imgWidth As Long, imgHeight As Long
Application.ScreenUpdating = False
tPicture = Selection.Name
With Selection
imgHeight = .ShapeRange.Height
imgWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa1" 'Type your Sheet Name
Selection.Border.LineStyle = 0
tChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
With .Shapes(tChart)
.Width = imgWidth
.Height = imgHeight
End With
.Shapes(tPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="D:\MyPic.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR
.Shapes(tChart).Cut
End With
Application.ScreenUpdating = True
Set Picture = LoadPicture("D:\MyPic.jpg")
ActiveSheet.Pictures.Delete
End Sub


Teşekkür ederim üstad. Lakin bende çalışmasa da fikir verdi. Umarım bu doğrultuda işimi görebilirim Durumdan haberdar edeceğim.

Farklı çalışması olan arkadaşlardan, bu çalışmalarını da beklediğimi bildirmek isterim.

[alibuyuk66]

erseldemirel2 Bey.
Kodlar çalışıyor fakat Userformun üzerindi Image1 nesnesi çinde değil userformun bacgroundu olarak ekliyor. Image1 in içine nasıl eklenebilir.

[erseldemirel2]

Aşağıdaki kodun altına ekleme yaptım image1 nesnesine ekler. Mevcut kodda fazlalıkların silinmesi lazım. Sonuçda userform body çıkmasına gerek kalmaz. Şuan araştırmadım ama daha sade çözümlerde vardır.

Kod: Tümünü seç

Private Sub CommandButton1_Click()
Range("A1:C10").Copy 'GÖRÜNTÜ ALINAN YER
Range("H4").Select 'GEÇİCİ YER DEĞİŞTİRİLEBİLİR
ActiveSheet.Pictures.Paste Link:=True
ActiveSheet.Pictures.Select
Application.CutCopyMode = False
Dim tChart As String, tPicture As String
Dim imgWidth As Long, imgHeight As Long
Application.ScreenUpdating = False
tPicture = Selection.Name
With Selection
imgHeight = .ShapeRange.Height
imgWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sayfa1" 'Type your Sheet Name
Selection.Border.LineStyle = 0
tChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
With .Shapes(tChart)
.Width = imgWidth
.Height = imgHeight
End With
.Shapes(tPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="D:\MyPic.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR
.Shapes(tChart).Cut
End With
Application.ScreenUpdating = True
Set Picture = LoadPicture("D:\MyPic.jpg")
ActiveSheet.Pictures.Delete
End Sub

Kod: Tümünü seç

Set Img = UserForm1.Image1
With Img
.Picture = LoadPicture("D:\MyPic.jpg")
.PictureSizeMode = fmPictureSizeModeStretch
.Left = 50
.Top = 50
End With

[alibuyuk66]

Teşekkürler Ersel bey

[erseldemirel2]

Rica ederim kolay gelsin

[alooo]

Eline, koluna, bilgine sağlık üstadım. Var olasın.

[alibuyuk66]

Merhaba Ersel bey.
aşağıdaki dosya yolunu Dinamik dosya yoluna nasıl çevirebilirim. Ben yapıyorm fakat hep hata alıyorum.

Kod: Tümünü seç

.ChartObjects(1).Chart.Export Filename:="D:\MyPic.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR

.ChartObjects(1).Chart.Export Filename:="D:\MyPic.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR


[erseldemirel2]

Dinamikten kasıt değişken olmasıdır. Bu ifadede file için değişken belirlersiniz; file ne olursa o dosyaya bakar.

Örnek: kodların içinde yoldan önce bu girilirse;

Kod: Tümünü seç

file="5.foto"

olsun

Kod: Tümünü seç

.ChartObjects(1).Chart.Export Filename:="D:\" & file &.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR

sonuç

.ChartObjects(1).Chart.Export Filename:="D:\5.foto.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR

olur.

[alibuyuk66]

Demek istediğim. Dosyanın bulunduğu klasör.
Ağ ortamında olacağı için değişebilir. Aktif dosya nerede ise oraya kaydeysin

[erseldemirel2]

Dosyanın bulunduğu klasör en basitinden;

"ThisWorkbook.path" dir.

.ChartObjects(1).Chart.Export Filename:=ThisWorkbook.path & "\" & file &.jpg", FilterName:="jpg" 'GEÇİCİ DOSYA SİLİNEBİLİR