• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru makronun açılan sayfalarda da çalışması

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Kod:
Sub kalan_zaman()
Dim i As Date, s As Date, g As Integer, t As Long, z As Date, c As Long, k As Date
Dim h As Double, a As Integer, y As Integer, j As Long, jj As Long, nn As String, pl As Range

Set s1 = Sheets("ŞABLON")

For Each pl In s1.Range("C28")
If IsDate(pl) = True And pl <> "" Then
i = CDate(Date): s = CDate(pl)
If CDate(i) > CDate(s) Then s1.Cells(pl.Row, "F") = "GEÇMİŞ": GoTo 10
t = Month(i): g = -1
z = DateSerial(Year(CDate(i)), Month(CDate(i)) + 1, 0)
If Day(i) = Day(z) Then j = 1
For c = CDbl(i) To CDbl(s)
g = g + 1
k = DateSerial(Year(CDate(c)), Month(CDate(c)) + 1, 0)
If Month(CDate(c)) <> t Then
If Day(k) = Day(CDate(c)) Then jj = j + 1
If Day(i) = Day(CDate(c)) Then h = True
If Day(k) < Day(z) And Day(CDate(c)) = Day(k) Then h = True
If jj = 2 Then h = True
End If
If h = True Then
t = Month(CDate(c))
a = a + 1
g = 0
h = 0
jj = j
End If
If a = 12 Then
y = y + 1: a = 0
End If
Next
If g > 0 Then nn = g & " GÜN"
If a > 0 Then nn = a & " AY"
If y > 0 Then nn = y & " YIL"

s1.Cells(pl.Row, "F") = nn
End If
10:
g = 0: a = 0: y = 0
Next pl

End Sub

yukarıda yer alan makro ŞABLON sayfasında çalışıyor.

Örnek : ŞABLON sayfasından 147 tane kopya oluşturdum ve her sayfaya farklı ad verdim. Her sayfanın adını da C2 hücresine yazdım.
Makronun sayfa adına göre de aktif çalışmasını nasıl sağlayabilirim?
 
Geri
Üst