Option Menü Hk.

L

link_me

Katılım
20 Şubat 2011
Mesajlar
116
Excel Vers. ve Dili
2010 versiyonu kulanmaktayım
Altın Üyelik Bitiş Tarihi
13/01/2022
Merhabalar ,
Vba da kendimi geliştirmek istiyorum arkadaşlar sizlerin sayesinde pat çat birşeyler yapmaya başladım nette bulduğum bir formu hem kendimi geliştirip hemde kendime göre uyarlamak adına birşeyler yapıyorum 2 çeşit option radio butonu ekledim fotosunu paylaşıyorum.
burda yapmak istediğim eklediğim radio butonlara nasıl bir kod yazmalıyım ki D ve N hücresine ekleme yapabileyim Mesela Kayıt Durumu Yeni yada eski birini seçince Formu Doldurum Kayıt Dediğimde D hücresine yazması kodlar ektedir.


Kod: 
'For More : merkez-ihayat.blogspot.com
Dim Yeni_mi As Boolean
Dim lbl() As New Class1

Private Sub CommandButton1_Click()
Dim Son_Dolu_Satir, Bos_Satir As Long
If Me.TextBox1.Value = "" _
Or Me.TextBox2.Value = "" _
Or Me.TextBox3.Value = "" _
Or Me.TextBox5.Value = "" Then
Call MsgBox("The fields are not complete", vbInformation, "Edit Contact")
Exit Sub
End If
                        Son_Dolu_Satir = Sheets("Data").Range("A65536").End(xlUp).Row
                
                        Bos_Satir = Son_Dolu_Satir + 1
                
                        Sheets("Data").Range("A" & Bos_Satir).Value = _
                                             Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
                
                        Sheets("Data").Range("B" & Bos_Satir).Value = TextBox1.Text
                
                        Sheets("Data").Range("C" & Bos_Satir).Value = TextBox2.Text
                
                        Sheets("Data").Range("D" & Bos_Satir).Value = TextBox3.Text
                        
                        Sheets("Data").Range("E" & Bos_Satir).Value = ComboBox1.Value
                        
                        Sheets("Data").Range("F" & Bos_Satir).Value = TextBox5.Text
                        
                        Sheets("Data").Range("G" & Bos_Satir).Value = TextBox6.Text
                        
                        Sheets("Data").Range("H" & Bos_Satir).Value = TextBox7.Text
                        
                        Sheets("Data").Range("I" & Bos_Satir).Value = TextBox8.Text
                        
                        Sheets("Data").Range("J" & Bos_Satir).Value = TextBox9.Text
                        
                        Sheets("Data").Range("K" & Bos_Satir).Value = TextBox10.Text
                        
                        Sheets("Data").Range("L" & Bos_Satir).Value = TextBox11.Text
                        
                        Sheets("Data").Range("N" & Bos_Satir).Value = TextBox12.Text
                        Sheets("Data").Range("M" & Bos_Satir).HorizontalAlignment = xlRight
                
                        Sheets("Data").Select
                                
                
                ListBox1.Clear
            refresh
            Label14.Caption = ListBox1.ListCount
        
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

Private Sub CommandButton3_Click()
Dim Silinecek_Satir, i As Long
Dim cevap As String

If TextBox1 = "" Or TextBox2 = "" Then
Call MsgBox("Choose the contact to delete", vbInformation, "Delete Contact")
Exit Sub
End If
    If ListBox1.ListIndex >= 0 Then
cevap = MsgBox("İçerik Silinecektir." _
& vbCrLf & "Devam Etmek İstiyor musunuz?", vbYesNo, "Delete Approval")
           If cevap = vbYes Then
           Yeni_mi = True
           Silinecek_Satir = ListBox1.ListIndex + 2
           Sheets("Data").Rows(Silinecek_Satir).Delete
      End If
      End If
    
    CommandButton8_Click
    For i = 2 To Range("a65536").End(3).Row
            Cells(i, 1).Value = i - 1
        Next i
        
    refresh
    Label14.Caption = ListBox1.ListCount
End Sub

Private Sub CommandButton4_Click()
CommandButton8_Click
TextBox1.SetFocus
End Sub

Private Sub CommandButton5_Click()
On Error Resume Next
Dim sons As Long
Sheets("Data2").Select
sons = Sheets("Data2").[a65536].End(3).Row + 1
Cells(sons, 1) = TextBox13.Value
TextBox13 = ""
refresh2

End Sub

Private Sub CommandButton6_Click()
On Error Resume Next
Dim say, Silinecek_Satir2 As Long
Dim ara As Range

 If ListBox2.ListIndex >= 0 Then
cevap = MsgBox("The contact to be deleted." _
& vbCrLf & "Do you want to proceed?", vbYesNo, "Delete Approval")
    
        If cevap = vbYes Then
            Yeni_mi = True
            Silinecek_Satir2 = ListBox2.ListIndex + 2
            Sheets("Data2").Rows(Silinecek_Satir2).Delete
        End If
        End If
    
TextBox13 = ""
ListBox2.Clear
refresh2
End Sub

Private Sub CommandButton7_Click()
TextBox13 = Empty
End Sub

Private Sub CommandButton8_Click()
Dim del As Control
For Each del In UserForm1.Controls
If TypeName(del) = "TextBox" Or TypeName(del) = "ComboBox" Then
del.Text = Empty
End If
Next del
ListBox1.Value = ""
ListBox2.Value = ""
End Sub

Private Sub CommandButton9_Click()
Dim Degistirilecek_Satir As Long
Dim sor As String
If TextBox1 = "" Or TextBox2 = "" Then
Call MsgBox("click the contact so it can be updated", vbInformation, "Edit Contact")
Exit Sub
End If

sor = MsgBox("Emin Misiniz?", vbYesNo)
If sor = vbNo Then Exit Sub

 Degistirilecek_Satir = ListBox1.ListIndex + 2
                        
                        Sheets("Data").Range("B" & Degistirilecek_Satir).Value = TextBox1.Text
                
                        Sheets("Data").Range("C" & Degistirilecek_Satir).Value = TextBox2.Text
                
                        Sheets("Data").Range("D" & Degistirilecek_Satir).Value = TextBox3.Text
                        
                        Sheets("Data").Range("E" & Degistirilecek_Satir).Value = ComboBox1.Value
                        
                        Sheets("Data").Range("F" & Degistirilecek_Satir).Value = TextBox5.Text
                        
                        Sheets("Data").Range("G" & Degistirilecek_Satir).Value = TextBox6.Text
                        
                        Sheets("Data").Range("H" & Degistirilecek_Satir).Value = TextBox7.Text
                        
                        Sheets("Data").Range("I" & Degistirilecek_Satir).Value = TextBox8.Text
                        
                        Sheets("Data").Range("J" & Degistirilecek_Satir).Value = TextBox9.Text
                        
                        Sheets("Data").Range("K" & Degistirilecek_Satir).Value = TextBox10.Text
                        
                        Sheets("Data").Range("L" & Degistirilecek_Satir).Value = TextBox11.Text
                        Sheets("Data").Range("N" & Degistirilecek_Satir).Value = TextBox12.Text
                        Sheets("Data").Range("M" & Degistirilecek_Satir).HorizontalAlignment = xlRight

                        Sheets("Data").Select
Call MsgBox("İçerik Güncellenmiştir.", vbInformation, "Edit Contact")
refresh
End Sub

Private Sub Label1_Click()

End Sub

Private Sub ListBox1_Click()
Dim Bulunan_Satir_No As Long
    
    Bulunan_Satir_No = ListBox1.ListIndex + 2
    
    TextBox1.Text = Sheets("Data").Range("B" & Bulunan_Satir_No).Value
    
    TextBox2.Text = Sheets("Data").Range("C" & Bulunan_Satir_No).Value
    
    TextBox3.Text = Sheets("Data").Range("D" & Bulunan_Satir_No).Value
    
   ComboBox1.Value = Sheets("Data").Range("E" & Bulunan_Satir_No).Value
    
    TextBox5.Text = Sheets("Data").Range("F" & Bulunan_Satir_No).Value
    
    TextBox6.Text = Sheets("Data").Range("G" & Bulunan_Satir_No).Value
    
    TextBox7.Text = Sheets("Data").Range("H" & Bulunan_Satir_No).Value
    
    TextBox8.Text = Sheets("Data").Range("I" & Bulunan_Satir_No).Value
    
    TextBox9.Text = Sheets("Data").Range("J" & Bulunan_Satir_No).Value
    
    TextBox10.Text = Sheets("Data").Range("K" & Bulunan_Satir_No).Value
    
    TextBox11.Text = Sheets("Data").Range("L" & Bulunan_Satir_No).Value
    
    TextBox12.Text = Sheets("Data").Range("M" & Bulunan_Satir_No).Value
    TextBox12.Text = VBA.Format(TextBox12, "dd.mm.yyyy")

End Sub
Private Sub ListBox2_Click()
Dim No As Long
No = ListBox2.ListIndex + 2
TextBox13.Value = Sheets("Data2").Range("A" & No).Value
End Sub
Private Sub TextBox13_Change()
On Error Resume Next
TextBox13 = Evaluate("=proper(""" & TextBox13 & """)")
End Sub
Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex + 1
    End With
End Sub

Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex - 1
    End With
    End Sub
Sub refresh()
Dim sds As Long
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "74;78"
sds = Sheets("Data").[a65536].End(xlUp).Row
ListBox1.List = Sheets("Data").Range("B2:C" & sds).Value
End Sub
Sub refresh2()
Dim sds2 As Long
sds2 = Sheets("Data2").[a65536].End(xlUp).Row
ListBox2.List = Sheets("Data2").Range("A2:A" & sds2).Value
End Sub

Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
    Application.Visible = False
    ToggleButton1.BackColor = &H80FF&
   End If
   If ToggleButton1.Value = True Then
    Application.Visible = True
    ToggleButton1.BackColor = &H80FF&
End If
End Sub
Private Sub Label19_Click()
Workbooks.Add
End Sub
Private Sub Label20_Click()
Application.Dialogs(xlDialogOpen).Show
End Sub

Private Sub Label21_Click()
ActiveWorkbook.Save
End Sub

Private Sub Label22_Click()
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Private Sub Label23_Click()
UserForm1.Hide
ActiveSheet.PrintPreview
UserForm1.Show
End Sub

Private Sub Label24_Click()
ActiveSheet.PrintOut
End Sub

Private Sub Label25_Click()
UserForm1.Hide
End Sub
Private Sub Label18_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

Label18.Font.Bold = True
Label18.Font.Size = 11
Frame2.Visible = True
End Sub

Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Frame2.Visible = False
Label18.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub Frame2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Dim a As Integer
For a = 19 To 25
Controls("label" & a).BackColor = &H8000000F
Controls("label" & a).ForeColor = &H80000006
Next
End Sub
Private Sub UserForm_Initialize()
Dim x, sds, sds2, say1 As Long
       
say1 = WorksheetFunction.CountA(Worksheets("Data2").Range("a:a"))
ComboBox1.RowSource = "Data2!a2:a" & say1
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "74;78"
   
sds = Sheets("Data").[a65536].End(xlUp).Row
ListBox1.List = Sheets("Data").Range("B2:C" & sds).Value
      
sds2 = Sheets("Data2").[a65536].End(xlUp).Row
ListBox2.List = Sheets("Data2").Range("A2:A" & sds2).Value
 
Label14.Caption = ListBox1.ListCount
ListBox1.ListIndex = 0

Frame2.Visible = False
ReDim Preserve lbl(6)
For a = 19 To 25
Set lbl(a - 19).lbl = Controls("label" & a)
Next
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Frame2.Visible = False
Label18.Font.Bold = False
End Sub
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,218
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
OptionButton seçimine göre Kayıt için;

Private Sub kaydet_butonu_Click()
If OptionButton1 = True Then Cells(1, 1) = "yeni"
If OptionButton2 = True Then Cells(1, 1) = "eski"
End Sub

Siz kendi seçiminize ve yazdıracağınız yere göre gereken düzenlemeyi yaparsınız.

İyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst