- Katılım
- 8 Mart 2009
- Mesajlar
- 504
- Excel Vers. ve Dili
- 2010
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("iller")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(Target.Row, 2).Value
Set renk = [M:M].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "m").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(Target.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
bu kodlar ile haritada renklendirme yapabiliyoruz, ancak nasıl bir değişiklik yaparsak dolgu efeklerinden desen sitili uygulayabilirim. (renk yerine desen sitili)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("iller")
Set S2 = Sheets(ActiveSheet.Name)
İL = Cells(Target.Row, 2).Value
Set renk = [M:M].Find(Target.Value, lookat:=xlWhole)
If Not renk Is Nothing Then
rnk = Cells(renk.Row, "m").Interior.ColorIndex
Target.Interior.ColorIndex = rnk
Cells(Target.Row, 2).Interior.ColorIndex = rnk
End If
Set hcr = ActiveCell
Sheets("Harita").Select
ActiveSheet.Shapes(İL).Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = rnk + 7
Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCenter, 1, 0.1
S2.Select
hcr.Select
Application.ScreenUpdating = True
End Sub
bu kodlar ile haritada renklendirme yapabiliyoruz, ancak nasıl bir değişiklik yaparsak dolgu efeklerinden desen sitili uygulayabilirim. (renk yerine desen sitili)
