• DİKKAT

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

makroyu nasıl tüm sayfalara uygularım?

Katılım
29 Ekim 2011
Mesajlar
138
Excel Vers. ve Dili
2007 türkçe
Merhaba,

Bir çalışma kitabı var içinde 50 tane sayfa var . Her gün de bir sayfa ekleniyor. Aşağıdaki makro kodunu aynı anda hepsine ve yeni eklenecek sayfalara nasıl uygulayabilirim?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Application.CutCopyMode = xlCopy Then Exit Sub
If Application.CutCopyMode = xlCut Then Exit Sub
Call RenkSil
[j1] = 1
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions.Add Type:=xlExpression, Formula1:="=$j$1=1"
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Interior.ColorIndex = 3
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.Bold = True
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.ColorIndex = 33
End Sub
Sub RenkSil()
On Error Resume Next
Cells.FormatConditions.Delete
End Sub
 
Merhaba,
İlgili kodu ThisWorkbook kod bölümüne şu şekilde workbook_sheetselectionchange olayının içine yazıp deneyiniz.
Kod:
[COLOR="Red"]Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)[/COLOR]
On Error Resume Next
If Application.CutCopyMode = xlCopy Then Exit Sub
If Application.CutCopyMode = xlCut Then Exit Sub
Call RenkSil
[j1] = 1
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions.Add Type:=xlExpression, Formula1:="=$j$1=1"
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Interior.ColorIndex = 3
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.Bold = True
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.ColorIndex = 33
End Sub
Sub RenkSil()
On Error Resume Next
Cells.FormatConditions.Delete
End Sub
 
Merhaba,
İlgili kodu ThisWorkbook kod bölümüne şu şekilde workbook_sheetselectionchange olayının içine yazıp deneyiniz.
Kod:
[COLOR="Red"]Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)[/COLOR]
On Error Resume Next
If Application.CutCopyMode = xlCopy Then Exit Sub
If Application.CutCopyMode = xlCut Then Exit Sub
Call RenkSil
[j1] = 1
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions.Add Type:=xlExpression, Formula1:="=$j$1=1"
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Interior.ColorIndex = 3
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.Bold = True
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 32)).FormatConditions(1).Font.ColorIndex = 33
End Sub
Sub RenkSil()
On Error Resume Next
Cells.FormatConditions.Delete
End Sub

teşekkürler
 
Geri
Üst