Sayfada çalışan kodu kitabın tamamında kullanmak istiyorum.

[Bora K]

Günaydın Arkadaşlar.

Aşağıdaki kodu Makro Kaydet yöntemi ile elde ettim. "ActiveSheet.Shapes("Picture 2").Select"
Aktif sayfadaki bir yada 2 resmi seçtim sanırım ve bunlara aşağıdaki işlemleri uyguladım.
Bu kod ile aşağıdaki sıralanan işlemlerin kitaptaki tüm resimlere uygulanmasını istiyorum.
Lakin makro kodlarından anlamadığım için yapamıyorum. Sizlerden istirhamım şayet yapılma
imkanı varsa kodu tüm kitapta çalışacak şekilde revize etmeniz. Teşekkür ederim.


Sub Makro1()
'
' Makro1 Makro
'
'

'
ActiveSheet.Shapes("Picture 2").Select
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
End Sub

 

[monelogg]

Merhabalar, kodu şu haliyle deneyiniz, umarım işinizi görür.

Sub Makro1()
'
' Makro1 Makro
'
'

'
Dim ws As Worksheet
For Each ws In Worksheets
With ws
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
End With
Next

End Sub

 

[korel durmaz]

Öncelikle kitabındaki tüm sayfaların ismini 1, 2,3,4....isimlendir.
Son sayfa 25 olsun.

Sub Makro1()
'
' Makro1 Makro
'
'

'
For i=1 To 25
Sheets(i).Select

ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#

Next i
End Sub


Umarım yardımcı olur.

 

[Bora K]

Merhabalar

Sayın monelogg
Sayın korel durmaz

Alakanızdan dolayı ayrı ayrı teşekkür ederim arkadaşlar.

Sayın monelogg kodu denedim lakin sadece makronun tetiklendiği sayfadaki resimleri seçerek
onlara işlem yapıyor. Diğer sayfalarda işlem yapmıyor.
Eğer imkanınız var ise kodu tekrar düzenleyebilirseniz sevinirim.


Sayın Korel Durmaz sizin kodu denemedim. Çünkü sayfa isimlerini değiştirmek cazip gelmiyor.
Sayfa isimlerini değiştirmekle diğer işlem aynı yoğunlukta. alakanız için teşekkür ederim.

 

[monelogg]

Merhabalar, şu kodları dener misiniz?

Sub Makro1()
'
' Makro1 Makro
'
'

'
Dim i As Integer
Dim j As Integer
Dim s()
For i = 1 To Sheets.Count
ReDim Preserve s(j)
s(j) = Sheets(i).Name
Sheets(s(j)).Select
With ws
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
End With
j = j + 1
Next i
Sheets(s).Select
End Sub

 

[Bora K]

Merhaba
bu satırda hata veriyor.
Selection.ShapeRange.PictureFormat.Brightness = 0.5

Dosyayı ekleyeceğim lakin özel resimler mevcut.
Herhangi bir resimle siz deneme yapabilirseniz şayet ona göre kodu düzenleyebilirsiniz.

Ben şunu yapmak istiyorum resme sağ klik > resmi biçimlendir > sıkıştır > web ekranına tik koyuyorum.
tamam > tamam deyip çıkıyorum. (bunu yaparken excel bazı şeyleri kendisi ayarlıyor zaten)

Bu uygulamayı makronun kitabın tüm sayfalarında bütün resimlere yapmasını istiyorum.
Vaktiniz olduğunda bakabilirseniz sevinirim. Teşekkür ederim.

 

[monelogg]

Aslında ben öyle bir dosya yaptım, hatta 0 olan değerleri 100 yapıp öyle de denedim ve bütün sayfalarda sonuç verdi.
Yaptığım dosya

For i = 1 To Sheets.Count
j = 0
ReDim Preserve s(j)

"j=0" eklediğim haliyle şu şekildedir:

 

[Bora K]

Merhaba; dosya benim makinada açılamıyor maalesef
2003 formatında tekrardan yükleyebilirmisiniz?

 

[monelogg]

2003 formatını yükledim, inceleyebilirsiniz:

 

[Bora K]

Merhaba
Dosyayı indirdim baktım kod gayet güzel çalışıyor.

İçindeki makroyu kendi dosyama aktardım yine önceki hatayı aldım.
"runtime error 2147024891 (80070005)
bu üyeye yalnızca resim yada OLE nesnesi ile erişilebilir."
debug a ok diyorum sonra bu satırı işaret ediyor.
Selection.ShapeRange.PictureFormat.Brightness = 0.5

Başlığın ismindede hiç resim geçmiyor. Konunun buraya geleceğini tahmin edemedim
elbette Üstadlar belki bir tavsiye verirlerdi...

Sayın monelogg gayretiniz için çok teşekkür ederim. Kod bana yardımcı olamadı.
Ümid ediyorum ki diğer arkadaşların işini görecektir.

İyi geceler.

 

[monelogg]

Anlıyorum, rica ederim ne demek. Keşke yardımcı olabilseydim.
Umarım bir çözüm bulursunuz, iyi geceler.