• DİKKAT

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

Gelinen hücre üzerinde bilgi ekranı gözükmesi

Katılım
17 Şubat 2006
Mesajlar
184
Excel Vers. ve Dili
2003
ingilizce
merhaba arkadaşlar,

bir mali tablo üzerinde herhangi bir hücre üzerine gelindiğinde, o hücre değerinin o ayın toplamına yüzdesini gösteren küçük bir bilgi ekranı çıkması sağlanabilir mi?

detaylı bilgiyi içeren küçük bir tabloyu eke koyuyorum.

yardımlarınız için teşekkür ederim.
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim i As Integer
    i = Cells(Rows.Count, "A").End(3).Row
    
    If Intersect(Target, Range("C2:N" & i - 1)) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    MsgBox "Oran : " & Format(Round(Target.Value / Cells(i, Target.Column) * 100, 2), "%0.00")
    
End Sub
 
Nejdet bey,

ilginiz için teşekkür ederim.
dediğiniz formulasyonu kod sayfasına yazdım ama bir netice alamadım.
kaydederken hata veriyor.
dosyaya bakabilirseniz çok memnun olurum.

sağlıcakla kalın
 

Ekli dosyalar

Merhaba,

Siz ayrı bir Modul olarak kodları eklemişsiniz.

Sheet1 e sağ tıklayın, Kod Görüntüle deyin
Çıkan bölüme kodları kopyalayın.
 
Merak ettim ve denedim, hedefte bir hücre seçildiğinde runtime error 6, overflow; end/debug hatası veriyor.
 
Merak ettim ve denedim, hedefte bir hücre seçildiğinde runtime error 6, overflow; end/debug hatası veriyor.

Seçilen hücre boş ise veriyordu, onun kontrolünü unutmuşum. İlk mesajıma ekledim.

Kod:
    If Target.Value = "" Then Exit Sub
 
Yine birkaç şey merak ettim:

1 - Neden ortalamayı alırken toplam hücresini de dikkate almıyor, o hücrenin toplam olduğunu ayırabiliyor herhalde diye anlıyorum, doğru mudur?

2 - Msgbox yerine addcomment ile açıklama şeklinde ilave yapılabilir mi? Başka bir soruda bulduğum çözümü uyarlamaya çalıştım ama yapamadım. msgbox satırı yerine aşağıdaki kodları denedim ama hata veriyor (assignment to constant not permitted):

Kod:
Target.AddComment
    Target.Comment.Visible = False
    Target.Comment.text = "Oran : " & Format(Round(Target.Value / Cells(i, Target.Column) * 100, 2), "%0.00")
 
Merhaba,

Necdet beyin kodlarında kullandığı -1 ifadesi ile son satırda işlem yapılamamaktadır.

Açıklama kutusu ile sonuçları görmek için aşağıdaki kodu kullanabilirsiniz.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    i = Cells(Rows.Count, "A").End(3).Row
    
    If Intersect(Target, Range("C2:N" & i - 1)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    On Error Resume Next
    Target.ClearComments
    On Error GoTo 0
    
    Target.AddComment
    Target.Comment.Visible = False
    Target.Comment.Text "Oran : " & Format(Round(Target.Value / Cells(i, Target.Column) * 100, 2), "%0.00")
End Sub
 
Teşekkürler arkadaşlar.

son bir soru, açıklamanın yazı tipi, boyutu ve rengini makro ile değiştirmeye çalıştım değiştiremedim. Makro kaydet yoluyla bir hücreye açıklama ekliyor ve biçimini istediğim gibi yaptıktan sonra kaydı durduruyorum. kodlara baktığımda biçimle ilgili hiçbir kod bulunmuyor, çalıştırdığımda da sadece açıklama ekliyor, biçimde herhangi bir değişiklik yapmıyor.

Makroyla açıklama biçimini değiştiremez miyiz?

Bu arada arkadaşın konusuna salça oldum, kusura bakmasın; fırsattan istifade bir şeyler kapmaya çalışıyorum:)
 
Verdiğiniz bilgiler ışığında kodları aşağıdaki gibi değiştirirsek arkadaşın istediği açıklama bölümünde gerçekleşiyor:



Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    i = Cells(Rows.Count, "A").End(3).Row
    
    If Intersect(Target, Range("C2:N" & i - 1)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    On Error Resume Next
    Target.ClearComments
    On Error GoTo 0
    
    Target.AddComment
    Target.Comment.Visible = False
    Target.Comment.Text "Oran : " & Format(Round(Target.Value / Cells(i, Target.Column) * 100, 2), "%0.00")
    Call biçim
    End Sub
    Sub biçim()

  Dim ws As Worksheet
  Dim cmt As Comment
  For Each ws In ActiveWorkbook.Worksheets
    For Each cmt In ws.Comments
      With cmt.Shape.TextFrame.Characters.Font
        .Name = "Times New Roman"
        .Size = 18
        .ColorIndex = 3
        .Bold = True
      End With
    Next cmt
  Next ws

End Sub

Öğrettiğiniz bilgiler ve gösterdiğiniz yollar için çok teşekkürler.
 
Geri
Üst