• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Yardım Excell hücresinin resim olarak kaydetme vba kod yazarak.

D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
Sub tümhücre()

For i = 2 To 400

Range("D2:F2").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Range("G2").Paste

Next i
End Sub
Bu kodu makro kaydederek aldım . for Next döngüsüyle tüm sayfaya nasıl uygulayabilirim .Teşekkürler
 
ozkansabanci

ozkansabanci

Excel VBA Developer
Uzman
Katılım
28 May 2018
Mesajlar
238
En iyi yanıt
7
Puanları
28
Yaş
38
Konum
İstanbul
Web sitesi
analistadam.com
Ad Soyad
Özkan Sabancı
Office Vers.
Microsoft 365 Apps for enterprise TR
dead001' Alıntı:
Sub tümhücre()

For i = 2 To 400

Range("D2:F2").Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Range("G2").Paste

Next i
End Sub
Bu kodu makro kaydederek aldım . for Next döngüsüyle tüm sayfaya nasıl uygulayabilirim .Teşekkürler
Genişletmek için tıkla ...

Tam olarak yapılmak istenen nedir?
 
D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
D2 ile f2 hücresini sayfaya resim olarak kaydetme istiyorum . Bunu ortadaki kod ile yapıyorum. Ama aşağıya doğru diğer hücrelerinde resimlerini kaydetmesini istiyorum .d3;f3 d4;f4 ... vs
 
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Merhaba;
Alternatif olsun (kodlar alıntıdır)
Boş bir modüle;

Sub jpg_kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Dim objTemp As Object
Dim chtMyChart As Chart
Dim rngImg As Range
Dim No As Long
Dim TempName As String
For i = 2 To 400
If Cells(i, "d") <> "" Then
Set rngImg = Range("d" & i & ":f" & i) 'resim alanı
rngImg.Copy
Set objTemp = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
objTemp.Select
ActiveSheet.Paste
objTemp.Delete
TempName = ThisWorkbook.Path & "\" & i & ".jpg"
With Selection
.CopyPicture 1, 2
Set chtMyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
chtMyChart = ShapeRange.Line.Visible = msoFalse
With chtMyChart
.Paste
.Export TempName
.Parent.Delete
End With
.Delete
End With
Set rngImg = Nothing
Set objTemp = Nothing
End If
Next i
MsgBox ("İşlem Bitti.")
Application.ScreenUpdating = True
End Sub

Kodlarını ekleyip deneyin.
Dosyanın olduğu klasöre döngü adı ile (2,3,4.. vs) .jpg olarak kayıt yapar.
İyi çalışmalar.
 
D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
muygun' Alıntı:
Merhaba;
Alternatif olsun (kodlar alıntıdır)
Boş bir modüle;

Sub jpg_kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Dim objTemp As Object
Dim chtMyChart As Chart
Dim rngImg As Range
Dim No As Long
Dim TempName As String
For i = 2 To 400
If Cells(i, "d") <> "" Then
Set rngImg = Range("d" & i & ":f" & i) 'resim alanı
rngImg.Copy
Set objTemp = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
objTemp.Select
ActiveSheet.Paste
objTemp.Delete
TempName = ThisWorkbook.Path & "\" & i & ".jpg"
With Selection
.CopyPicture 1, 2
Set chtMyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
chtMyChart = ShapeRange.Line.Visible = msoFalse
With chtMyChart
.Paste
.Export TempName
.Parent.Delete
End With
.Delete
End With
Set rngImg = Nothing
Set objTemp = Nothing
End If
Next i
MsgBox ("İşlem Bitti.")
Application.ScreenUpdating = True
End Sub

Kodlarını ekleyip deneyin.
Dosyanın olduğu klasöre döngü adı ile (2,3,4.. vs) .jpg olarak kayıt yapar.
İyi çalışmalar.
Genişletmek için tıkla ...
Kayıt yapıyor ama resimleri boş hücre çıkarıyor. Sorun nerede bulamadım
 
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Merhaba;
Ofis 2003 denemelerimde sorunsuz kayıt yapıyor.
 

Ekli dosyalar

  • dead001-alanı resim olarak kaydet.rar
    151.9 KB · Görüntüleme: 21
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Denediğim pc win7 32 bit ve ofis 2003
Ofis versiyon farkından olabilir.
Deneme şansınız varsa ofis 2003 yüklü bir pc de deneyin.
 
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Ofis 2010 da da çalıştı (sorun yok)
 

Ekli dosyalar

  • 2.jpg
    2.jpg
    2 KB · Görüntüleme: 6
  • 9.jpg
    9.jpg
    2.5 KB · Görüntüleme: 6
D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
Office 2007 yüklüyorum orada bir deniyeceğim ,İlgilendiğiniz için teşekkür ederim.
 
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Sonucu bende merak ediyorum.
 
D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
Sub jpg_kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Dim objTemp As Object
Dim chtMyChart As Chart
Dim rngImg As Range
Dim No As Long
Dim TempName As String
For i = 2 To 40
If Cells(i, "d") <> "" Then
Set rngImg = Range("d" & i & ":f" & i) 'resim alanı
rngImg.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
Set objTemp = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
objTemp.Select
ActiveSheet.Paste
objTemp.Delete
TempName = ThisWorkbook.Path & "\" & Cells(i, "a") & Cells(i, "d") & ".jpg"
With Selection
.CopyPicture 1, 2
Set chtMyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
chtMyChart = ShapeRange.Line.Visible = msoFalse
With chtMyChart
.Paste
.Export TempName
.Parent.Delete
End With
.Delete
End With
Set rngImg = Nothing
Set objTemp = Nothing
End If
Next i
MsgBox ("İşlem Bitti.")
Application.ScreenUpdating = True
End Sub
' Ben biraz değiştirdim istediğim hücrenin ismini resim ismi olarak kaydettirdim.
 
muygun

muygun

Uzman
Katılım
19 Ağu 2018
Mesajlar
480
En iyi yanıt
28
Puanları
43
Konum
Excel 2003
Ad Soyad
Mustafa UYGUN
Office Vers.
Office 2003
Merhaba;
TempName = ThisWorkbook.Path & "\" & Cells(i, "a") & Cells(i, "d") & ".jpg"

Satırında ThisWorkbook.Path bulunduğu klasörü tanımlıyor.
Bunu "C:\resim" olarak değiştirirseniz C de resim klasörüne kayıt yapar
İyi çalışmalar.
 
D

dead001

Yeni Üye
Katılım
29 Ağu 2019
Mesajlar
13
En iyi yanıt
0
Puanları
1
Yaş
39
Konum
bursa
Ad Soyad
osman bektaş
muygun' Alıntı:
Merhaba;
TempName = ThisWorkbook.Path & "\" & Cells(i, "a") & Cells(i, "d") & ".jpg"

Satırında ThisWorkbook.Path bulunduğu klasörü tanımlıyor.
Bunu "C:\resim" olarak değiştirirseniz C de resim klasörüne kayıt yapar
İyi çalışmalar.
Genişletmek için tıkla ...
Teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst Alt