Formülleri Korunan Sayfaya Renk Aktarımı

[1Al2Ver]

Merhaba,

1) Data(I) sayfasından aşağıdaki kod ile Tablo(I) sayfasına renk aktarıyorum
(Kod ; Sayın Levent Menteşoğlu)

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, [a:b]) Is Nothing Then
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23) = vbNullString
Target.Offset(1).Select
End If
If Intersect(Target, [C3:V30]) Is Nothing Then Exit Sub
Dim SD As Object, SAT As Object
Dim BUL As Range, SÜTUN As Byte
Set SD = Sheets("DATA(I)")
Set SAT = Sheets("TABLO(I)")
Set BUL = SAT.[B:B].Find(Cells(Target.Row, 2), , xlValues)
If Not BUL Is Nothing Then
If Target.Interior.ColorIndex <> xlNone Then
Cancel = True
Select Case Target.Column
Case Is = 3
SAT.Cells(BUL.Row, "C").Interior.ColorIndex = Target.Interior.ColorIndex
Case Is > 3
SÜTUN = Target.Column + ((Target.Column - 3) * 5)
SAT.Cells(BUL.Row, SÜTUN).Interior.ColorIndex = Target.Interior.ColorIndex
End Select
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End If
Else
MsgBox Cells(Target.Row, 2) & " ismi bulunamamıştır." & Chr(10) & "Lütfen kontrol ediniz !", vbExclamation, "Dikkat !"
End If
End Sub

Ancak Tablo(I) sayfasındak formüller korumalı olduğunda aktarılan renk, Tablo(I) deki yerini alamıyor, bu sorunu aşabilirmiyiz ?

2) Sayfada formülleri koruyan kod ;

Sub FormulKoru()
ActiveSheet.Unprotect "1223345"
Range("A1:V300").Locked = False
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).Locked = True
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).FormulaHidden = True
ActiveSheet.Protect "1223345", DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "Bitti"
End Sub

Teşekkür ederim.

 

[Ayhan Ercan]

Merhaba

Formulleri koruyan kodun tersini yazarak bunu renk aktarma kodunun başına eklemek ve sonuna da yine FormulKoru makrosunu çağırmak olabilirmi?

Örnek:
Makrolara aşağıdaki makroyu ilave edin..

Sub FormulKoruma()
ActiveSheet.Unprotect "1223345"
Range("A1:V300").Locked = False
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).Locked = False
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).FormulaHidden = False
ActiveSheet.Protect "1223345", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sonra da

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Call FormulKoruma
........................
........................
........................
Call FormulKoru
End sub

 

[1Al2Ver]

Merhaba

Formulleri koruyan kodun tersini yazarak bunu renk aktarma kodunun başına eklemek ve sonuna da yine FormulKoru makrosunu çağırmak olabilirmi?

Örnek:
Makrolara aşağıdaki makroyu ilave edin..

Sub FormulKoruma()
ActiveSheet.Unprotect "1223345"
Range("A1:V300").Locked = False
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).Locked = False
Range("A1:V300").SpecialCells(xlCellTypeFormulas, 23).FormulaHidden = False
ActiveSheet.Protect "1223345", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sonra da

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Call FormulKoruma
........................
........................
........................
Call FormulKoru
End sub

Sayın Ayhan Ercan, merhaba

FormulKoru makrosu Modül2'de, diğer makro ise Data(I) sayfasındadır.

Dolayısı ile 2 tane (FormulKoru ve FormulKoruma) formül koruyan makro oldu,

Bir kaç deneme yaptım, belki de işlem benim halledemediklerimdendir,

İlginiz için teşekkür ederim.