Çakışan makro ile sayfa kodları

[AKREP1]

Modulel 1 deki makroSub koru()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect "1"
Next
Application.ScreenUpdating = True
End Sub
Sub koruac()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect "1"
Next
Application.ScreenUpdating = True
End Sub
Sayfanın kod kısmındakiPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then Exit Sub
Target.EntireRow.Interior.ColorIndex = 5
Target.EntireColumn.Interior.ColorIndex = 26
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [d:aj]) Is Nothing Then Exit Sub
If Target.Cells.Value > 99 Then
Target.Cells.Font.Size = 8
Else
Target.Cells.Font.Size = 10
End If
End Sub
Aralarında bir çakışma var.Sayfa korumayı devre dışı bırakınca kodlar çalışıyor.Bunu nasıl düzeltip hem koruma makrosu hemde kodlar çakışmadan çalışsın.Saygılarımla.Teşekkürler.

 

[uzmanamele]

merhaba
aşağıdaki şekilde denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then Exit Sub
Target.EntireRow.Interior.ColorIndex = 5
Target.EntireColumn.Interior.ColorIndex = 26
End Sub

 

[AKREP1]

merhaba
aşağıdaki şekilde denermisiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then Exit Sub
Target.EntireRow.Interior.ColorIndex = 5
Target.EntireColumn.Interior.ColorIndex = 26
End Sub

Sağolun.Denedim .Korumayı kaldırınca düzeliyor.

 

[AKREP1]

Hem koruma makrosu hem de sayfa kodları aynı anda çalışamaz mı?Teşekkürler

 

[AKREP1]

Yardım lütfen.

 

[AKREP1]

Yardım ederseniz sevinirim.

 

[AKREP1]

Modulel 1 deki makroSub koru()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Protect "1"
Next
Application.ScreenUpdating = True
End Sub
Sub koruac()
Application.ScreenUpdating = False
For sayfa = 1 To Sheets.Count
Sheets(sayfa).Unprotect "1"
Next
Application.ScreenUpdating = True
End Sub
Sayfanın kod kısmındakiPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then Exit Sub
Target.EntireRow.Interior.ColorIndex = 5
Target.EntireColumn.Interior.ColorIndex = 26
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [d:aj]) Is Nothing Then Exit Sub
If Target.Cells.Value > 99 Then
Target.Cells.Font.Size = 8
Else
Target.Cells.Font.Size = 10
End If
End Sub
Aralarında bir çakışma var.Sayfa korumayı devre dışı bırakınca kodlar çalışıyor.Bunu nasıl düzeltip hem koruma makrosu hemde kodlar çakışmadan çalışsın.Saygılarımla.Teşekkürler.

Yardımlarınızı bekliyorum.Saygılar

 

[Orion1]

Çalışma sayfasındaki kodu aşağıdaki şekilde kullanınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "1"
Cells.Interior.ColorIndex = 1 'Turn off previous use Cells.Interior.ColorIndex = 1 'Turn off previous use
If Cells(1, 1) = "." Then goto son
Target.EntireRow.Interior.ColorIndex = 5
Target.EntireColumn.Interior.ColorIndex = 26
son:
ActiveSheet.Protect "1"
End Sub

 

[AKREP1]

İlginize teşekkürler.Ama yine hücre içerisine 100 yazıldığında punto 8 olmuyor.Sayfa koruması devre dışı kalmadan çalışmıyor.

 

[Orion1]

Dosyanız ekte.

 

[AKREP1]

İlginize gerçekten çok çok teşekkürler.Ama yine hücre içerisine 100 yazıldığında punto 8 olmuyor.Sayfa koruması devre dışı kalmadan çalışmıyor.

 

[Orion1]

İlginize gerçekten çok çok teşekkürler.Ama yine hücre içerisine 100 yazıldığında punto 8 olmuyor.Sayfa koruması devre dışı kalmadan çalışmıyor.

Ekli dosyayı inceleyiniz.

 

[AKREP1]

Gerçekten size çok çok teşekkürler sonunda istediğim gibi oldu.Sabrınıza ve emeğinize saygılarımla.

 

[Orion1]

Gerçekten size çok çok teşekkürler sonunda istediğim gibi oldu.Sabrınıza ve emeğinize saygılarımla.

Rica ederim.
İyi çalışmalar.