ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[muzos80]

Kolay gelsin,
Ben makro ile aşağıdaki kod ile resim ekliyorum fakat 8 hücre birleştirilmiş bir excel de sanki birleştilmemiş gibi resmi küçük yapıştırıyor ben hücreye göre her taraftan sığdırmasını istiyorum daha önce kullandığım kod başka bilgisayarda resmin görünmemesinden dolayı aşağıdaki kod ile değiştirdim öncekinde böyle sorun yoktu yardımlarınızı bekliyorum.

Dim sPicture As String, pic As Picture

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
ActiveSheet.Shapes.AddPicture sPicture, msoFalse, msoCTrue, ActiveCell.Left + 2, ActiveCell.Top + 2, ActiveCell.Width - 4, ActiveCell.Height - 4
Set pic = Nothing

End Sub

[EfeM]

Merhaba,
Resim özelliklerini eklerken, ActiveCell özelliği yerine birleştirilmiş aralığının Range özelliğinden yararlanarak olayı çözebilirsiniz.

Örnek;
Dim Cs as Worksheet
Dim Rng as Range
set Cs=ThisWorkbook.Sheets("Sayfa1")
set Rng=Cs.Range("A1:J1")

Buradaki Rng değişkeninin genişlik, yükseklik gibi özelliklerini kullanabilirsiniz.

Kolay gelsin.

[muzos80]

Merhaba,
Resim özelliklerini eklerken, ActiveCell özelliği yerine birleştirilmiş aralığının Range özelliğinden yararlanarak olayı çözebilirsiniz.

Örnek;
Dim Cs as Worksheet
Dim Rng as Range
set Cs=ThisWorkbook.Sheets("Sayfa1")
set Rng=Cs.Range("A1:J1")

Buradaki Rng değişkeninin genişlik, yükseklik gibi özelliklerini kullanabilirsiniz.

Kolay gelsin.

Teşekkür ederim ben yeniyim tam olarak anlamadım ama sayfa1 olarak değilde bende sürekli sayfa ekleyerek gidiyorum bir butona tıklayarak seçili birleştirilmiş hücre boyutuna göre resim ekletmeye çalışıyorum yardımlarınızı bekliyorum.

[EfeM]

Merhaba,

Kodu aşağıdaki gibi değiştirdim. Anladığım kadarıyla sayfayı kendiniz ekleyip resim yapıştıracağınız hücreleri kendiniz birleştiriyorsunuz. Bu işinizi görebilir.

Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range
Set Cs = ActiveSheet

ActiveCell.Select
Set Rng = Cs.Range(Selection.Address)

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
ActiveSheet.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4

End Sub

Kolay gelsin.

[muzos80]

Merhaba,

Kodu aşağıdaki gibi değiştirdim. Anladığım kadarıyla sayfayı kendiniz ekleyip resim yapıştıracağınız hücreleri kendiniz birleştiriyorsunuz. Bu işinizi görebilir.

Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range
Set Cs = ActiveSheet
Çok teşekkür ederim ağda kimse eklediğim resimleri göremiyordu şimdi görünüyor çok çok sağolun.
ActiveCell.Select
Set Rng = Cs.Range(Selection.Address)

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
ActiveSheet.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4

End Sub

Kolay gelsin.

[EfeM]

Rica ederim, kolay gelsin.

[wexulans]

Merhaba,

Kodu aşağıdaki gibi değiştirdim. Anladığım kadarıyla sayfayı kendiniz ekleyip resim yapıştıracağınız hücreleri kendiniz birleştiriyorsunuz. Bu işinizi görebilir.

Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range
Set Cs = ActiveSheet
Çok teşekkür ederim ağda kimse eklediğim resimleri göremiyordu şimdi görünüyor çok çok sağolun.
ActiveCell.Select
Set Rng = Cs.Range(Selection.Address)

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
ActiveSheet.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4

End Sub

Kolay gelsin.

Bu kodlar benimde işime yaramakta, öncelikle çok teşekkür ederim. Fakat bu kodlarda seçili birleştirilmiş hücreyse resmi ekleyip ortalıyor. Bu kodları şu şekilde revize edebilirmiyiz mümkünmü
Excel çalışma kitabında bulunan 15 ayrı sayfada birde fazla birleştirilmiş hücreye tıklayıp setiğim resmi otomatik olarak eklesin istiyorum mümnkün mü acaba?

[Miraç CAN]

Tabii ki mümkün,
Bir resim seçeceksiniz ve seçtiğiniz resmi sayfadan seçeceğiniz birleştirilmiş hücrelere eklenmesini istiyorsunuz, doğru değil mi?
Ve her seçilen alana aynı resim eklenecek.

Excel dosyanızda işlemin uygulanmayacağı sayfalar var ise bunların isimleri, ya da uygulanacak sayfa isimleri veya varsa bir sistematiğini verirseniz daha pratik olacaktır.

[wexulans]

Tabii ki mümkün,
Bir resim seçeceksiniz ve seçtiğiniz resmi sayfadan seçeceğiniz birleştirilmiş hücrelere eklenmesini istiyorsunuz, doğru değil mi?
Ve her seçilen alana aynı resim eklenecek.

Excel dosyanızda işlemin uygulanmayacağı sayfalar var ise bunların isimleri, ya da uygulanacak sayfa isimleri veya varsa bir sistematiğini verirseniz daha pratik olacaktır.

Excel çalışma kitabımda, 15 adet sayfa(sayfa1, sayfa2, .... , gibi) var her sayfada (u2:ae6) birleştirilmiş hücrelerim mevcut bunları tek tek makroma ekleyip sayfa1 e ekleyeceğim commandbutton ile resim(logo) seçip bu logonun makroya yazdıgım sayfalara ait hücrelere ekleyip en boy şeklinde ortalasın istiyorum.

[Miraç CAN]

her sayfada (u2:ae6) birleştirilmiş hücrelerim mevcut

Birleştirilmiş tek bir alan mı, birden fazla birleştirilmiş alan mı?

[wexulans]

her sayfada (u2:ae6) birleştirilmiş hücrelerim mevcut

Birleştirilmiş tek bir alan mı, birden fazla birleştirilmiş alan mı?

bazı sayfalarda birden fazla alan bazı sayfalarda tek bir alan, bu alanları makro koduna tek tek eklemek istiyorum.
Şöyle açıklayayım excelde yazdırılacak belli dosya sayfaları mevcut ve bu sayfaların sağ üst köşelerine logo eklemek istiyorum. sayfa 1 de sadece 1 yaprak uzunlugunda yazı oldugundan sag üst köşedeki birleştirilmiş hücreye bir adet belki ama diğer sayfalarda birden fazla yaprak oldugundan onlarda her yeni sayfadaki sag üst köşeye gelen kısma birer logo şeklinde resimler makro ile eklesin istiyorum.
Eskiden bunu ben sayfa bir e resim ekle diyerek resmi ekliyordum ve kopyala makrosu kaydederek tek tek aynı boyuttaki birleştirilmiş hücreyi istediğim her sayfaya kopyala yapıştır makrosuyla çoğaltıyordum ama bu şekilde makro çok kasıyor ve uzun sürüyor. O yüzden bu şekilde yapabilrmiyim diye araştırmaktaydım.

[EfeM]

Merhabalar,
Ben de kendimce sayfa isimlerini bir diziye atarak düzenlemiştim kodu ama benzeri düzenlemeyle hücre aralıkları için de şartlandırma yapabilirsiniz.



Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range
'Set Cs = ActiveSheet
Dim diziSayfalar() As String
diziSayfalar = Split("Sayfa1,Sayfa2,Sayfa3")

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
For Each Cs In ThisWorkbook.Sheets
ActiveCell.Select
With Cs
Set Rng = .Range("u2:ae6")
Rng.Merge
.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4
End With
Next
End Sub

[wexulans]

Merhabalar,
Ben de kendimce sayfa isimlerini bir diziye atarak düzenlemiştim kodu ama benzeri düzenlemeyle hücre aralıkları için de şartlandırma yapabilirsiniz.



Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range
'Set Cs = ActiveSheet
Dim diziSayfalar() As String
diziSayfalar = Split("Sayfa1,Sayfa2,Sayfa3")

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
For Each Cs In ThisWorkbook.Sheets
ActiveCell.Select
With Cs
Set Rng = .Range("u2:ae6")
Rng.Merge
.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4
End With
Next
End Sub

Evet yaklaşık olarak kod işimi görecek hale geldi fakat tek sorun her sayfada birleştirilmiş hücrelerin ayrı sütun ve satırlar bunlar sabit değiller.

Örnek olarak sayfa1 de A1:K6
sayfa2 de U1:AE5
sayfa3 de U2:AE6
sayfa4 de L6:V10 A55:K59 A102:K106 gibi benim belirlediğim 15 sayfa için tek tek makro koduna nasıl ekeleyebilirim.

[EfeM]

Peki he alan için resim ayrı mı, yoksa aynı resimi mi eklemek istiyorsun?

[EfeM]

Bu kodu inceleyebilirsin. Aynı resimleri kullanığını düşünerek yeniden düzenledim.

Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range, Rng2 As Range, z%

Dim diziSayfalar() As String
diziSayfalar = Split("Sayfa1,Sayfa2,Sayfa3", ",")

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
For z = 0 To UBound(diziSayfalar)
For Each Cs In ThisWorkbook.Sheets

With Cs

If .Name = diziSayfalar(z) Then
Select Case .Name
Case "Sayfa1"
Set Rng = .Range("a7:d10")
Case "Sayfa2"
Set Rng = .Range("b10:e15")
Case "Sayfa3"
Set Rng = .Range("b10:e15")
Set Rng2 = .Range("g10:k15")
.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng2.Left + 2, Rng2.Top + 2, Rng2.Width - 4, Rng2.Height - 4

Case Else
MsgBox "Resim eklemek için Adres değeri belirtilmemiş"
Set Rng = Nothing
Exit For
End Select
.Activate
Rng.Merge

.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4
Exit For
End If
End With
Next
Next z
End Sub

[wexulans]

Bu kodu inceleyebilirsin. Aynı resimleri kullanığını düşünerek yeniden düzenledim.

Sub resimEkle()

Dim sPicture As String, Cs As Worksheet, Rng As Range, Rng2 As Range, z%

Dim diziSayfalar() As String
diziSayfalar = Split("Sayfa1,Sayfa2,Sayfa3", ",")

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")

If sPicture = "False" Then Exit Sub
For z = 0 To UBound(diziSayfalar)
For Each Cs In ThisWorkbook.Sheets

With Cs

If .Name = diziSayfalar(z) Then
Select Case .Name
Case "Sayfa1"
Set Rng = .Range("a7:d10")
Case "Sayfa2"
Set Rng = .Range("b10:e15")
Case "Sayfa3"
Set Rng = .Range("b10:e15")
Set Rng2 = .Range("g10:k15")
.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng2.Left + 2, Rng2.Top + 2, Rng2.Width - 4, Rng2.Height - 4

Case Else
MsgBox "Resim eklemek için Adres değeri belirtilmemiş"
Set Rng = Nothing
Exit For
End Select
.Activate
Rng.Merge

.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4
Exit For
End If
End With
Next
Next z
End Sub

Teşekkür ederim ama kod işe yaramıyor. Yani çalışıyor ama resimler gelmiyor. Hatada vermiyor.

[EfeM]

Ben çalıştırdıktan sonra gönderdim kodları size.
Örnek dosyayı da ekliyorum.

[Miraç CAN]

her sayfada (u2:ae6) birleştirilmiş hücrelerim mevcut

Birleştirilmiş tek bir alan mı, birden fazla birleştirilmiş alan mı?

bazı sayfalarda birden fazla alan bazı sayfalarda tek bir alan, bu alanları makro koduna tek tek eklemek istiyorum.
Şöyle açıklayayım excelde yazdırılacak belli dosya sayfaları mevcut ve bu sayfaların sağ üst köşelerine logo eklemek istiyorum. sayfa 1 de sadece 1 yaprak uzunlugunda yazı oldugundan sag üst köşedeki birleştirilmiş hücreye bir adet belki ama diğer sayfalarda birden fazla yaprak oldugundan onlarda her yeni sayfadaki sag üst köşeye gelen kısma birer logo şeklinde resimler makro ile eklesin istiyorum.
Eskiden bunu ben sayfa bir e resim ekle diyerek resmi ekliyordum ve kopyala makrosu kaydederek tek tek aynı boyuttaki birleştirilmiş hücreyi istediğim her sayfaya kopyala yapıştır makrosuyla çoğaltıyordum ama bu şekilde makro çok kasıyor ve uzun sürüyor. O yüzden bu şekilde yapabilrmiyim diye araştırmaktaydım.

Resim eklenecek alanın etrafında (sağ/sol/alt/üst) referans alabileceğimiz sabit bir içerik/başlık vb. var ise ya da belli bir sistematiği/kalıbı var ise o referansa göre aratıp buldurabiliriz.

Sayfanızda sadece resim eklenecek alan birleştirilmiş ve başka birleştirilmiş alan yok ise de yapabiliriz.
Resim yerleşimi değişken sayfalardan bir kaçı veya tamamını ekleyebilirseniz inceleyelim.

[wexulans]

Ben çalıştırdıktan sonra gönderdim kodları size.
Örnek dosyayı da ekliyorum.

Hocam çok teşekkür ederim. Çalıştı sayfa isimlerinde hata varmış şu an düzeldi.
Sadece logo eklediğimde en boy oranını bozmadan sadece birleştirilmiş hücreye sığdırıp ortalaması için ne değiştirmem gerekir?
Logoların orjinal hallerini bozuyorda.

[EfeM]

Rica ederim, sene sonu yoğunluktan hemen yazamadım. Ama istersen aşağıdaki kod da Rng.Width - Rng.Height değerleri ile oynayarak hizalayabilirsin.

.Shapes.AddPicture sPicture, msoFalse, msoCTrue, Rng.Left + 2, Rng.Top + 2, Rng.Width - 4, Rng.Height - 4

Kolay gelsin.