Excelde pek çok sheetin alt bilgisini tek hamlede değiştirmek

[ulashcan]

Arkadaşlar, benim için çok önemli...

Excelde pek çok sayfası olan raporların her bir sayfasına girip teker teker alt bilgilerini ( protokol numaraları ) değiştirmem gerekiyor.

Tüm raporların ( her bir excel dosyası için tek numara var ) protokol numaraları farklı, her sheet için ayrı ayrı uğraşmam çok zamanımı alıyor.

Örnek: Bir raporun 12345 no'lu protokol sayısını her sheetin altına otomatik yazdırmalıyım

Kolay yolu var mıdır???

 

[Ferhat Pazarçevirdi]

Aşağıdaki makroyu, herbir çalışma kitabında bir defa çalıştırınız.

Option Explicit
 
Public Sub Tum_Sheetlerde_AltBilgi_Degistir()
    
    Dim sh As Worksheet
    Dim Protokol_No As String
    
    Protokol_No = InputBox("Protokol No Giriniz", "Protokol")
    
    If StrPtr(Protokol_No) = 0 Then: Exit Sub
    
    For Each sh In ThisWorkbook.Worksheets
        
        With sh.PageSetup
            .CenterFooter = Protokol_No
                   'Sola yazdırmak için : .LeftFooter = ""
                   'Sağa yazdırmak için : .RightFooter = ""
        End With
    
    Next
 
End Sub

 

[uzmanamele]

merhaba
sayfalarınız aynıysa; tüm sayfaları seçin, sayfa yapısından alt bilgiyi seçerek protokol noyu yazın. sayfaları çözdüğünüzde, tüm sayfalarda alt bilgi yazılmış olur.

 

[ulashcan]

merhaba
sayfalarınız aynıysa; tüm sayfaları seçin, sayfa yapısından alt bilgiyi seçerek protokol noyu yazın. sayfaları çözdüğünüzde, tüm sayfalarda alt bilgi yazılmış olur.

Süper, bu hiç aklıma gelmemişti. Denedim oldu, teşekkürler...

@Ferhat, senin verdiğin makroyu da denedim, doğru şekilde çalışıyor, ilgin için teşekkürler...

 

[ulashcan]

@Ferhat hocam, makroya buton yaptım, gayet şık çalışıyor. öğrenmek istediğim birşey daha var.

Inputbox'a yazdığımız protokol numarasını, her sheet de olan ve "Rapor No:" yazan hücreyi buldurup 2 hücre sağındaki boş hücreye yazdırabilir miyiz?

Bir de inputbox'a yazdığımız rakamları altbilgiye eklerken önüne "Protokol No" kelimelerini ekletmek istiyorum, verdiğin makro kodlarına bunu nasıl ekleyebilirim?

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi deneyiniz.

Option Explicit
 
Public Sub Tum_Sheetlerde_AltBilgi_Degistir()
    
    Dim sh As Worksheet
    Dim Protokol_No As String
    Dim bul As Range
    
    Protokol_No = InputBox("Protokol No Giriniz", "Protokol")
    
    If StrPtr(Protokol_No) = 0 Then: Exit Sub
    
    For Each sh In ThisWorkbook.Worksheets
        
        Set bul = sh.Cells.Find("Rapor No:")
        
        If Not bul Is Nothing Then
            bul.Offset(0, 2).Value = Protokol_No
        End If
        
        With sh.PageSetup
            .CenterFooter = "Protokol No : " & Protokol_No
[COLOR=darkgreen]                   'Sola yazdırmak için : .LeftFooter = ""
                   'Sağa yazdırmak için : .RightFooter = ""[/COLOR]
        End With
    
    Next
 
    Set bul = Nothing
 
End Sub

 

[ulashcan]

Aşağıdaki gibi deneyiniz.

Option Explicit
 
Public Sub Tum_Sheetlerde_AltBilgi_Degistir()
    
    Dim sh As Worksheet
    Dim Protokol_No As String
    Dim bul As Range
    
    Protokol_No = InputBox("Protokol No Giriniz", "Protokol")
    
    If StrPtr(Protokol_No) = 0 Then: Exit Sub
    
    For Each sh In ThisWorkbook.Worksheets
        
        Set bul = sh.Cells.Find("Rapor No:")
        
        If Not bul Is Nothing Then
            bul.Offset(0, 2).Value = Protokol_No
        End If
        
        With sh.PageSetup
            .CenterFooter = "Protokol No : " & Protokol_No
[COLOR=darkgreen]                   'Sola yazdırmak için : .LeftFooter = ""
                   'Sağa yazdırmak için : .RightFooter = ""[/COLOR]
        End With
    
    Next
 
    Set bul = Nothing
 
End Sub

Harikasın, ne kadar işime yaradığını bir bilsen... Çok teşekkür ederim. Eksik olma

 

[ulashcan]

Bu inputbox'a çoklu giriş yaptırmak ve farklı değerleri buldurup yine 2 hücre yanına input box girilen değerleri yazdırmak istiyorum.

Yani Rapor No'yu girip "Rapor No:" nun iki yanına yazdırdığımız gibi, örneğin Rapor tarihi, Birim adı gibi değerleri de yine sayfalarda aratıp iki hücre yanına yazdırmak gibi.

Sizin verdiğiniz kodda ilgili kısmı kopyalayıp aşağı yapıştırdım ve yapabildiğim kadarıyla değerleri değiştirdim ama For control variable already in use hatası veriyor, sanırım ayrı bir döngü açmak gerekecek.

Bu arada yazdığınız kodları inceleyip neyin neden yapıldığını anlamaya çalışıyorum, taa 90'larda Basic ile birşeyler yapıyordum ama uzak kalmışız ondan sonra

Kendimce değiştirmeye çalıştığım kod burada, araya yeni döngü açabilir misiniz? bir taenesini yapsanız ben diğerleri için uğraşırım... Not: inputbox'da tüm değerleri bir kerede alt alta girmek daha kullanışlı olacak.

Dim sh As Worksheet
Dim Protokol_No As String
Dim Kontrol_Tarihi As String
Dim Denetci_Adi As String
Dim Magaza_Muduru As String
Dim Magaza_Adi As String
Dim bul As Range

Protokol_No = InputBox("Protokol No Giriniz", "Protokol")

If StrPtr(Protokol_No) = 0 Then: Exit Sub

For Each sh In ThisWorkbook.Worksheets

Set bul = sh.Cells.Find("Rapor No")

If Not bul Is Nothing Then
bul.Offset(0, 2).Value = Protokol_No

End If

Kontrol_Tarihi = InputBox("Kontrol Tarihi Giriniz", "Kontrol_Tarihi")

If StrPtr(Kontrol_Tarihi) = 0 Then: Exit Sub

For Each sh In ThisWorkbook.Worksheets

Set bul = sh.Cells.Find("Kontrol Tarihi")

If Not bul Is Nothing Then
bul.Offset(0, 2).Value = Kontrol_Tarihi

End If


With sh.PageSetup
.LeftFooter = "Protokol No : " & Protokol_No
'Sola yazdırmak için : .LeftFooter = ""
'Sağa yazdırmak için : .RightFooter = ""
End With

Next

Set bul = Nothing

End Sub

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi nesne isimleri kullanarak bir Userform tasarlayın ...

Userformun kod bölümüne aşağıdakileri kopyalayın.

Option Explicit
Private Sub CommandButton1_Click()
    Dim sh As Worksheet
    Dim Protokol_No As String
    Dim bul As Range
    Dim aranacaklar()
    Dim i As Integer
    
    aranacaklar = Array("Protokol No:", "Kontrol Tarihi:", "Denetçi Adı:", "Mağaza Müdürü:", "Mağaza Adı:")
    
    For Each sh In ThisWorkbook.Worksheets
        
        For i = 0 To UBound(aranacaklar)
            Set bul = sh.Cells.Find(aranacaklar(i))
            
            If Not bul Is Nothing Then
                bul.Offset(0, 2).Value = Me.Controls("TextBox" & i + 1).Text
            End If
        
        Next i
        
        With sh.PageSetup
            .CenterFooter = "Protokol No : " & Protokol_No
[COLOR=darkgreen]                   'Sola yazdırmak için : .LeftFooter = ""
                   'Sağa yazdırmak için : .RightFooter = ""[/COLOR]
        End With
    Next
 
    Set bul = Nothing
End Sub
'-------------------------
Private Sub CommandButton2_Click()
    Unload Me
End Sub

UserFormu; sayfa üzerine koyacağınız bir başka butonla çalıştırabilirsiniz.

Sub Userform_Goster()
Userform1.Show
End Sub

Userform, üzerindeki TextBox'lara, istediğiniz şeyleri girdikten sonra; "Tamam" tuşuna basmanız kafidir ...

 

[ulashcan]

Tamam, çok güzel oldu, tekrar teşekkürler...

Altbilgi yazdırmak istediğim dosyalardan bazılarında worksheet yanında grafik sayfaları da var, kodda sadece worksheet'lere baktığından grafik sayfalarına altbilgi eklemiyor.

"For Each sh In ThisWorkbook.Worksheets" satırını ne şekilde değiştirirsek grafiklere de altbilgi yazmasını sağlayabiliriz?

 

[Ferhat Pazarçevirdi]

CommandButton1'in kodunu, şu şekilde revize ediniz. Bir önce verdiğim koda göre değişiklikler kırmızı ile gösterilmiştir.

Private Sub CommandButton1_Click()
[COLOR=red]   Dim sh As Object[/COLOR]
    Dim Protokol_No As String
    Dim bul As Range
    Dim aranacaklar()
    Dim i As Integer
 
    aranacaklar = Array("Protokol No:", "Kontrol Tarihi:", "Denetçi Adı:", "Mağaza Müdürü:", "Mağaza Adı:")
 
[COLOR=red]   For Each sh In ThisWorkbook.Sheets[/COLOR]
 
[COLOR=red]       If TypeOf sh Is Worksheet Then[/COLOR]
            For i = 0 To UBound(aranacaklar)
                Set bul = sh.Cells.Find(aranacaklar(i))
 
                If Not bul Is Nothing Then
                    bul.Offset(0, 2).Value = Me.Controls("TextBox" & i + 1).Text
                End If
 
            Next i
[COLOR=red]       End If[/COLOR]
 
        With sh.PageSetup
            .CenterFooter = "Protokol No : " & Protokol_No
                   'Sola yazdırmak için : .LeftFooter = ""
                   'Sağa yazdırmak için : .RightFooter = ""
        End With
    Next
 
    Set bul = Nothing
End Sub

 

[ulashcan]

İlginiz ve vakit ayırıp uğraştığınız için çok teşekkür ederim. Gerçekten çok yardımı oldu bu kodun