• DİKKAT

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

Tıklanan Hücrenin Biçim Değiştirmesi Kodu Hakkında Yardım

  • Konbuyu başlatan Konbuyu başlatan Desibel
  • Başlangıç tarihi Başlangıç tarihi
Katılım
27 Ağustos 2007
Mesajlar
27
Excel Vers. ve Dili
Office 2007 Türkçe
Merhabalar,

Aşağıdaki gibi bir kod bulup kendime göre uyarladım. Ama sanırım bu kod döngüyü iptal ettiğim halde sürekli çalışıyor. Ben bu kodun sadece H7:H45 hücreleri tıklandığında seçili hücre doluysa çalışmasını istiyorum. Mümkün müdür? Diğer hücreler seçilince çalışmaması lazım. Şimdiden teşekkürler.


Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("h1:h100")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
  ' For Each hucre In Sheets("Rehber").Range("h2:h45")
   If ActiveCell.Value <> "" Then
          Range("h6:r45").Font.Bold = False
          Range("h6:r45").Font.Size = 11
          Range("h7:r45").Font.ThemeColor = xlThemeColorLight1
          Range("h7:r45").Font.TintAndShade = 0.249977111117893
          Rows("6:40").RowHeight = 13.5
          
          
          ActiveCell.Font.Bold = True
          ActiveCell.Font.Size = 16
                           ActiveCell.Offset(0, 2).Font.Color = vbRed
       ActiveCell.Offset(0, 2).Font.Bold = True
              ActiveCell.Offset(0, 2).Font.Size = 16

       ActiveCell.EntireRow.AutoFit
       
 
      Exit Sub
     End If
  
 '  Next
    
End Sub
 
Kod:
If Intersect(Target, Range("h1:h100")) Is Nothing Then Exit Sub
Kod:
If Intersect(Target, Range("h7:h45")) Is Nothing Then Exit Sub
Şeklinde değiştirin.
 
hamitcan bey, çok teşekkür ederim. Ben söz konusu kodun işlevinin tam tersi olduğunu düşünüyordum. Meğer sorun oymuş :) Tekrar teşekkürler.
 
Geri
Üst