- Katılım
- 12 Ekim 2017
- Mesajlar
- 123
- Excel Vers. ve Dili
- 2011
Merhaba sayın forumdaşlar. Daha önce bir arkadaşımızın(Emir Hüseyin Çoban) yazmış olduğu macroda bir sorun oluşmakta debug dediğimde aldığım sarı hatayı da fotoğraf olarak ekledim.
macrodan bahsetmek gerekirse (ki ihtiyacınız olduğunu düşünmüyorum çünkü bu işte çok iyiler var aramızda).: macro aşağıdaki başlıkların denk gelmiş olduğu sayfa numaralarını içindekiler kısmına yazıyor. gizlenmiş olan başlıkları içindekilerden de gizliyor böylelikle otomatik bir şekilde içindekiler kısmı oluşmuş oluyor.
Bu konuda destek verebilecek olan? macroda neden bug alıyorum bilen var mı?
çok teşekkürler.
not: içeriği temizlemeye çalıştım fakat yinede bir kısmı kaldı. başlıkların hepsi duruyor üzerinde çalışılabilir durumdalar. çok teşekkürler.
macrodan bahsetmek gerekirse (ki ihtiyacınız olduğunu düşünmüyorum çünkü bu işte çok iyiler var aramızda).: macro aşağıdaki başlıkların denk gelmiş olduğu sayfa numaralarını içindekiler kısmına yazıyor. gizlenmiş olan başlıkları içindekilerden de gizliyor böylelikle otomatik bir şekilde içindekiler kısmı oluşmuş oluyor.
Bu konuda destek verebilecek olan? macroda neden bug alıyorum bilen var mı?
çok teşekkürler.
not: içeriği temizlemeye çalıştım fakat yinede bir kısmı kaldı. başlıkların hepsi duruyor üzerinde çalışılabilir durumdalar. çok teşekkürler.
Kod:
Sub kod()
Dim DikeySay As Integer, YataySay As Integer, SayfaNo As Integer
Dim Dikey As VPageBreak, Yatay As HPageBreak
If ActiveSheet.PageSetup.PrintArea = "" Then
MsgBox "Yazdırma Alanı Belirlenmemiş", vbCritical
Exit Sub
End If
içindekiler_başlangıç = 123
içindekiler_bitiş = 251
içindekier_başlıklar = "B"
sayfa_no_sütunu = "T"
sayfalar_başlangıç = 252
sayfa_başlıklar = "A"
Rows(içindekiler_başlangıç & ":" & içindekiler_bitiş).EntireRow.Hidden = False
Range(Cells(123, sayfa_no_sütunu), Cells(içindekiler_bitiş, sayfa_no_sütunu)).ClearContents
ActiveWindow.View = xlPageBreakPreview
For i = içindekiler_başlangıç To Cells(içindekiler_bitiş + 1, içindekier_başlıklar).End(3).Row
If IsError(Cells(i, içindekier_başlıklar)) Then
Rows(i).EntireRow.Hidden = True
GoTo sonraki
End If
If Cells(i, içindekier_başlıklar) = 0 Then
Rows(i).EntireRow.Hidden = True
GoTo sonraki
End If
If Cells(i, içindekier_başlıklar) = "" Then
Rows(i).EntireRow.Hidden = True
GoTo sonraki
End If
sonraki:
Next i
i = Empty
For i = içindekiler_başlangıç To Cells(içindekiler_bitiş + 1, içindekier_başlıklar).End(3).Row
If Rows(i).EntireRow.Hidden = False Then
For a = sayfalar_başlangıç To Cells(Rows.Count, sayfa_başlıklar).End(3).Row
If Cells(i, içindekier_başlıklar) = Cells(a, sayfa_başlıklar) Then
If Rows(a).EntireRow.Hidden = True Then Rows(i).EntireRow.Hidden = True
sat = Cells(a, sayfa_başlıklar).Row
süt = Cells(a, sayfa_başlıklar).Column
If ActiveSheet.PageSetup.Order = xlDownThenOver Then
YataySay = ActiveSheet.HPageBreaks.Count + 1
DikeySay = 1
Else
DikeySay = ActiveSheet.VPageBreaks.Count + 1
YataySay = 1
End If
SayfaNo = 1
For Each Dikey In ActiveSheet.VPageBreaks
If Dikey.Location.Column > süt Then Exit For
SayfaNo = SayfaNo + YataySay
Next Dikey
For Each Yatay In ActiveSheet.HPageBreaks
If Yatay.Location.Row > sat Then Exit For
SayfaNo = SayfaNo + DikeySay
Next Yatay
Cells(i, sayfa_no_sütunu) = SayfaNo
Exit For
End If
Next a
End If
Next i
ActiveWindow.View = xlNormalView
MsgBox "B i t t i "
End Sub