TextBox İle hücreye açıklama ekleme.

unalh · 26 Ekim 2009

S.a arkadaşlar ,

Açıklama oluşturma ile ilgili birkaç örnek buldum fakat Form üzerinde TextBox'lara yazılarak açıklama oluşturma bulamadım.

Benim yapmakl istediğim form üzerinden veri girişi yaparken belirlediğim bir hücreye açıklama oluşturmak,

Birde kayıt yaptığım verileri form üzerinden kontrol ederken açıklama olan kayıtların açıklamalarınıda görmek acaba mümkünmüdür.?

Şimdiden teşekkür ederim.

hamitcan · 26 Ekim 2009

Ben bir tanesi için yaptım, diğerlerini buna bakarak uyarlayabilirsiniz.

Kod:

Private Sub TextBox2_Change()
    With [a1]
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=TextBox2.Text
    End With
End Sub

unalh · 26 Ekim 2009

Hocam cevabınız için teşekkürler fakat istediğim açıklama her veri kayıt edişimde o veriye ait olan hesap numarası satırına kayıt yapsın.

peleryn · 26 Ekim 2009

Sanırım istediğinizin ilk bölümü bu:hey:

peleryn · 26 Ekim 2009

.Comment.Visible = True
araya bunu da eklerseniz sayfanızda açıklamalar görünür olacak şekilde kaydeder.
İyi çalışmalar dilerim.

hamitcan · 26 Ekim 2009

İlgili kodu aşağıdaki ile değiştirin. Bu arada güzel bir form yapmışsınız, TEBRİKLER !...

Kod:

Private Sub CommandButton1_Click()

Sheets("Data").Select
    Dim bak As Range '****
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = TextBox2.Value Then
            MsgBox "Bu Çek numarasi bulundu."
            Exit Sub
        End If
           If ComboBox1.Text = "" Then
    MsgBox "Hesap Adı Boş Geçilemez....", , "Kayit Hatasi!!!"
    Exit Sub
    End If
    
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox2.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydiniz bulundu"
            Exit Sub
        End If
    Next bak
        say = WorksheetFunction.CountA(Range("B1:B65500"))
TextBox1.Value = say
Cells(say + 1, 1).Value = TextBox1.Value
Cells(say + 1, 2).Value = ComboBox1.Value
With Cells(say + 1, 3)
        .Value = TextBox2.Value
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=TextBox11.Text
End With
Cells(say + 1, 4).Value = TextBox3.Value
Cells(say + 1, 5).Value = TextBox4.Value
Cells(say + 1, 6).Value = TextBox5.Value
    

    MsgBox "Yeni Çek Başarıyla Kayıt Yapılmıştır.İyi Çalışmalar Dilerim", vbInformation, "Sn.  " & Application.UserName
    Sheets("Data").Select
    Range("A2:A65500").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        '************************
    Sheets("Data").Select
    Range("B2:L65500").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("B2").Select '*********
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
    ComboBox1.SetFocus
    
    Unload UserForm2
    UserForm2.Show
   
    
End Sub

unalh · 26 Ekim 2009

peleryn cavabınız için teşekkürler istediğim bu fakat şöyle bir durum var her kayıt yaptığımda açıklama ekliyor açıklama seçildiği zaman eklenmesi daha mantıklı olur aksi takdirde kayıt yapılan her veride için sanki açıklama varmış gibi bir ibare oluyor.

unalh · 26 Ekim 2009

Sy. hamitcan ilginiz için teşekkürler.
Kodu değiştirdim fakat ben açıklama eklemediğim zaman kod hata veriyor.

hamitcan · 26 Ekim 2009

Kod:

Private Sub CommandButton1_Click()

Sheets("Data").Select
    Dim bak As Range '****
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = TextBox2.Value Then
            MsgBox "Bu Çek numarasi bulundu."
            Exit Sub
        End If
           If ComboBox1.Text = "" Then
    MsgBox "Hesap Adı Boş Geçilemez....", , "Kayit Hatasi!!!"
    Exit Sub
    End If
    
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox2.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydiniz bulundu"
            Exit Sub
        End If
    Next bak
        say = WorksheetFunction.CountA(Range("B1:B65500"))
TextBox1.Value = say
Cells(say + 1, 1).Value = TextBox1.Value
Cells(say + 1, 2).Value = ComboBox1.Value
If TextBox11 <> "" Then
With Cells(say + 1, 3)
        .Value = TextBox2.Value
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=TextBox11.Text
End With
Else
        Cells(say + 1, 3) = TextBox2.Value
End If
Cells(say + 1, 4).Value = TextBox3.Value
Cells(say + 1, 5).Value = TextBox4.Value
Cells(say + 1, 6).Value = TextBox5.Value
    

    MsgBox "Yeni Çek Başarıyla Kayıt Yapılmıştır.İyi Çalışmalar Dilerim", vbInformation, "Sn.  " & Application.UserName
    Sheets("Data").Select
    Range("A2:A65500").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        '************************
    Sheets("Data").Select
    Range("B2:L65500").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("B2").Select '*********
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
    ComboBox1.SetFocus
    
    Unload UserForm2
    UserForm2.Show
   
    
End Sub

unalh · 26 Ekim 2009

Sayın hamitcan gerçekten çok teşekkür ederim ilgine ve alakana istediğim gibi oldu.

Birde kayıt yaptığım verileri form üzerinden kontrol ederken açıklama olan kayıtların açıklamalarınıda görmek ve tekrar değiştirmek acaba mümkünmüdür.?

hamitcan · 26 Ekim 2009

Kayıtları nasıl çağırmak istediğinizi sizin belirlemeniz gerekiyor. Bundan sonrası yapmak kolay.

unalh · 26 Ekim 2009

Birtane Listwiev'im var buna aldırmak istiyorum Dosyayı ekte gönderiyorum Hocam hakkınızı helal edin sizide uğraştırıyorum.

peleryn · 26 Ekim 2009

sn unalh haklısınız.her seferinde kayıt yapıyor o ayrıntıyı düşünmemiştim.neyseki emin ellerdesiniz hamitcan hocam bu işi bitirir.üstelik sorunun devamı benim de işime yarayacak.iyi çalışmalar dilerim.

unalh · 27 Ekim 2009

S,a ,

Hocam hayırlı sabahlar varmı bir gelişme ???

unalh · 27 Ekim 2009

Konuyla ilgili bilgisi olan arkadaşlar vardır mutlaka.
Tekrar hatırlatma olsun diye gönderdim.

Teşekkürler.

hamitcan · 27 Ekim 2009

Kodlarınızı biraz değiştirdim.

Kod:

Private Sub ARAMA_Change()
 ListView1.ListItems.Clear
On Error Resume Next
FD = UCase(Replace(Replace(ARAMA, "ı", "I"), "i", "İ"))
For i = 2 To [B65536].End(xlUp).Row
    If UCase(Replace(Replace(Sheets("Data").Cells(i, 4).Value, "ı", "I"), "i", "İ")) _
    Like "*" & FD & "*" Then
                Set Liste = ListView1.ListItems.Add(, , Cells(i, 1).Value)
                    Liste.SubItems(1) = Cells(i, 9).Value
                    Liste.SubItems(2) = Cells(i, 10).Value
                    Liste.SubItems(3) = Cells(i, 5).Value
                    Liste.SubItems(4) = Cells(i, 7).Value
                    Liste.SubItems(5) = Cells(i, 8).Value
                    Liste.SubItems(6) = Cells(i, 6).Value
                    Liste.SubItems(7) = Cells(i, 1).Value
             End If
            Next i
    Set Liste = Nothing
End Sub


Private Sub CheckBox1_Click()
ARAMA.Enabled = True
ARAMA = ""
End Sub



Private Sub ComboBox2_Change()
Dim X As Long
  ListView1.ListItems.Clear
On Error Resume Next
FD = UCase(Replace(Replace(ComboBox2, "ı", "I"), "i", "İ"))
For i = 2 To [DATA!B65536].End(xlUp).Row
    If UCase(Replace(Replace(Sheets("Data").Cells(i, 2).Value, "ı", "I"), "i", "İ")) _
    Like "*" & FD & "*" Then
        If Not IsDate(ARAMA.Text) Then
            Set Liste = ListView1.ListItems.Add(, , Cells(i, 2).Value)
            Liste.SubItems(1) = Cells(i, 9).Value
            Liste.SubItems(2) = Cells(i, 10).Value
            Liste.SubItems(3) = Cells(i, 5).Value
            Liste.SubItems(4) = Cells(i, 7).Value
            Liste.SubItems(5) = Cells(i, 8).Value
            Liste.SubItems(6) = Cells(i, 6).Value
            Liste.SubItems(7) = Cells(i, 1).Value
        Else
            If CDate(Sheets("data").Cells(i, "D").Value) = CDate(ARAMA.Text) Then
                Set Liste = ListView1.ListItems.Add(, , Cells(i, 2).Value)
                Liste.SubItems(1) = Cells(i, 9).Value
                Liste.SubItems(2) = Cells(i, 10).Value
                Liste.SubItems(3) = Cells(i, 5).Value
                Liste.SubItems(4) = Cells(i, 7).Value
                Liste.SubItems(5) = Cells(i, 8).Value
                Liste.SubItems(6) = Cells(i, 6).Value
                Liste.SubItems(7) = Cells(i, 1).Value
            End If
        End If
        
    End If
Next i

    Set Liste = Nothing
End Sub

Private Sub CommandButton2_Click()
    On Error Resume Next
    Unload Yazdır
End Sub





Private Sub CommandButton3_Click()
Set Yaz = Sheets("Yazdır")
 
For s = 1 To ListView1.ListItems.Count
 
Yaz.Cells(s + 9, "A") = ListView1.ListItems(s).SubItems(1)
Yaz.Cells(s + 9, "B") = ListView1.ListItems(s).SubItems(2)
Yaz.Cells(s + 9, "C") = ListView1.ListItems(s).SubItems(3)
Yaz.Cells(s + 9, "D") = ListView1.ListItems(s).SubItems(4)
Yaz.Cells(s + 9, "E") = ListView1.ListItems(s).SubItems(5)
Yaz.Cells(s + 9, "F") = ListView1.ListItems(s).SubItems(6)
Next

 Unload Yazdır
 Unload UserForm1
 
         'ActiveWorkbook.Unprotect
         Yaz.Visible = True
         Yaz.PrintPreview
         Yaz.Visible = False
         'ActiveWorkbook.Protect
         Yaz.Range("A10:F33") = ""
         Sheets("Data").Select
         UserForm1.Show
         'Yazdır.Show

End Sub








Private Sub ListView1_Click()
 TextBox1 = ""
 Set cmt = Cells(ListView1.ListItems(ListView1.SelectedItem.Index).SubItems(7) + 1, 3).Comment
 If Not cmt Is Nothing Then TextBox1 = cmt.Text
 
End Sub



Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As stdole.OLE_YPOS_PIXELS)
    On Error Resume Next
     ListView1.ControlTipText = " Çek Yazdırma Ekranı..."
End Sub



Private Sub UserForm_Initialize()
    On Error Resume Next
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets("Data").Select
  Application.DisplayAlerts = True
  ListView1.ColumnHeaders.Clear
With ListView1.ColumnHeaders
    .Add , , "", 0, 0
    .Add , , "VADE TARİHİ", 60, 0
    .Add , , "TUTAR", 60, 0
    .Add , , "KEŞİDECİ / UNVAN", 127, 0
    .Add , , "BANKA ADI", 60, 0
    .Add , , "MUHATAP ŞUBE", 70, 0
    .Add , , "SERİ NUMARASI", 70, 0
    .Add , , "SIRA NO", 50, 0
    
End With
ListView1.ListItems.Clear
On Error Resume Next
Sheets("Data").Select
For i = 2 To [B65536].End(xlUp).Row
Set Liste = ListView1.ListItems.Add(, , Cells(i, 1).Value)
Liste.SubItems(1) = Cells(i, 9).Value
Liste.SubItems(2) = Cells(i, 10).Value
Liste.SubItems(3) = Cells(i, 5).Value
Liste.SubItems(4) = Cells(i, 7).Value
Liste.SubItems(5) = Cells(i, 8).Value
Liste.SubItems(6) = Cells(i, 6).Value
Liste.SubItems(7) = Cells(i, 11).Value
ComboBox1.AddItem Data.Cells(i, 2).Value

Next i
ARAMA = Format(Now, "dd.mm.yyyy")

ARAMA.Enabled = False


ComboBox2.Style = fmStyleDropDownList
ComboBox2.RowSource = "Veri!B2:B6"



End Sub


Private Sub ComboyaVeriler()
 With Me.ComboBox2
  .AddItem "Lütfen Seçiniz"
    
 End With
        
 End Sub

peleryn · 27 Ekim 2009

Hocam unalh arkadaşımdan önce ben denk geldim.Çözümünüz için teşekkür ederim.

unalh · 27 Ekim 2009

Hocam öncelikle Çok çok teşekkür ederim ilginize.
Aslında sizleride fazla rahatsız etmek istemiyorum fakat öğrenmek istediğim bir iki konu daha var eğer fazla olmassam sormak isterim. ???

hamitcan · 27 Ekim 2009

Sorularınız kısa olursa iyi olur. Ayrıca zamanım olursa yanıtlamaya çalışabilirim, belirteyim.

unalh · 27 Ekim 2009

Eklemiş olduğumuz açıklamayı değiştirme ve silme butonu eklememiz mümkünmü ?

Teşekkürler.

TextBox İle hücreye açıklama ekleme.

unalh

Ekli dosyalar

hamitcan

Uzman

unalh

Ekli dosyalar

peleryn

Ekli dosyalar

peleryn

hamitcan

Uzman

unalh

unalh

hamitcan

Uzman

unalh

hamitcan

Uzman

unalh

Ekli dosyalar

peleryn

unalh

unalh

hamitcan

Uzman

Ekli dosyalar

peleryn

unalh

hamitcan

Uzman

unalh

Ekli dosyalar