• DİKKAT

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

İki Farklı Kodu Aynı Sayfada Yazma

Katılım
1 Aralık 2005
Mesajlar
376
Excel Vers. ve Dili
EXCEL 2002
TÜRKÇE
Merhaba arkadaşlar,

Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan iki ayrı kodu bir vba sayfasında (penceresinde) nasıl ard arda yazarız?
 
ÖRNEK OLMASI BAKIMINDAN AYNI KOD SAYFASINDA OLMASINI İSTEDİĞİM KODLARI PAYLAŞIYORUM:


1. KOD:

Option Explicit
'Tasarı_Aylık_Plan sayfasında çalışma planındaki İzinliler kısmını haftanın günleri için aşağıda tespit edilen renklere boyar.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As Range, Sutun

If Intersect(Target, Range("Q2:Q3")) Is Nothing Then Exit Sub

Sutun = Cells(3, Columns.Count).End(1).Column

For Each Veri In Range("X3:" & Cells(3, Sutun + 5).Address(0, 0))
With Cells(6, Veri.Column).Resize(6, 1)
Veri.Font.ColorIndex = 0
Select Case Veri.Text
Case "Pazartesi": .Interior.ColorIndex = 38 'Gül
Case "Salı": .Interior.ColorIndex = 36 'Açık Sarı
Case "Çarşamba": .Interior.ColorIndex = 8 'Turkuaz
Case "Perşembe": .Interior.ColorIndex = 43 'Limon Rengi Yeşil
Case "Cuma": .Interior.ColorIndex = 39 'Açık Eflatun
Case "Cumartesi": .Interior.ColorIndex = 45 'Açık Turuncu
Case "Pazar": .Interior.ColorIndex = 15: Veri.Font.ColorIndex = 3 'Gri %25
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
Next
End Sub


2. KOD:




Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C58,D58")) Is Nothing Then Exit Sub

On Error Resume Next

If Range("C58") = "" Or Range("D58") = "" Then Exit Sub

If Range("C58") = Range("C25") Then
Range("C25").Interior.ColorIndex = 38
Else
Range("C25").Interior.ColorIndex = xlNone
End If

If Range("D58") = Range("H25") Then
Range("H25").Interior.ColorIndex = 39
Else
Range("H25").Interior.ColorIndex = xlNone
End If
End Sub
 
Arkadaşlar yardımlarınızı bekliyorum...
 
Geri
Üst