Sayfalar arası kayıt

[simsek3131]

değerli arkadaşlar ekte sunduğum dosya içerisine istediğim şeyleri sıraladım yardımcı olursanız memnun olurum şimdiden herkese teşekkür eder iyi çalışmalar dilerim

 

[simsek3131]

değerli üstadlar yardım edecek kimse yokmu

 

[Necdet]

değerli üstadlar yardım edecek kimse yokmu

Üzerinde çalışıyorum. Sabır biraz.

 

[simsek3131]

teşekkür ederim

 

[Necdet]

Merhaba,

İlk sayfayı Parametre sayfası olarak adlandırdım.

Konuyu tam olarak bilmediğimden İlçe ve Köy isimlerinin yazılacağı şekilde düzenledim.

A sütunu İlçe, B sütunu ise köy adlarının bulunduğu yer.

A ve B sütununa veri girildiğinde otomatik olarak sıralanır.

Yeni köy eklendiğinde -ki formda combobox2 seçildiğinde kontrolü yapılır- Sablon sayfasından oluşturulur.

Parametre sayfasındaki Kodlar:

Private Sub CommandButton1_Click()
    UserForm1.Show
 
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [A:B]) Is Nothing Or Target.Row < 2 Then Exit Sub
 
    Dim i As Long
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Target.Value = Application.WorksheetFunction.Proper(Target.Value)
 
    i = Cells(Rows.Count, Target.Column).End(3).Row
 
    If i < 2 Then i = 2
    Range(Cells(2, Target.Column), Cells(i, Target.Column)).Sort Key1:=Cells(1, Target.Column)
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
End Sub

Userformda üretici adı ve baba adını otomatik olarak yazım düzenine çevirttirdim.

Userform1 deki kodlar :

Private Sub ComboBox2_Change()
    Dim Evet    As String
 
    If ComboBox2.Value = "" Then Exit Sub
 
    If Not SayfaVarMi(ComboBox2.Value) Then
        Evet = MsgBox(ComboBox2.Value & " ADLI SAYFA YOK, AÇMAMI İSTER MİSİNİZ?", vbYesNo)
        If Evet = vbYes Then
            Application.ScreenUpdating = False
            Sheets("Sablon").Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = ComboBox2.Value
            Sheets("Parametre").Select
            Sheets(ComboBox2.Value).Range("B3") = ComboBox2.Value
            Application.ScreenUpdating = True
        Else
            ComboBox2.SetFocus
            ComboBox2.Value = ""
        End If
    End If
 
End Sub

Private Sub CommandButton1_Click()
    Dim i       As Long
    Dim Sh      As Worksheet
    Dim c       As Range
    Dim Nesne
 
    Set Sh = Sheets(ComboBox2.Value)
 
    If IsNumeric(TextBox1.Value) = False Then
        MsgBox "T.C NUMARASI NÜMERİK DEĞER OLMALI", vbCritical, "HATA...."
        TextBox1.SetFocus
        Exit Sub
    End If
 
    If Not Len(TextBox1.Value) = 11 Then
        MsgBox "T.C NUMARASI 11 HANE  OLMALI", vbCritical, "HATA...."
        TextBox1.SetFocus
        Exit Sub
    End If
 
    Set c = Sh.Range("A:A").Find(TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        MsgBox TextBox1.Value & " T.C NUMARASI DAHA ÖNCEKİ VERİLERDE VAR...."
        TextBox1.SetFocus
        Exit Sub
    End If
    i = Sh.Cells(Rows.Count, "A").End(3).Row + 1
    Sh.Range("B2") = ComboBox1.Value
    Sh.Cells(i, "A") = TextBox1.Value
    Sh.Cells(i, "B") = TextBox2.Value
    Sh.Cells(i, "C") = TextBox3.Value
    Sh.Cells(i, "D") = TextBox4.Value
    Sh.Cells(i, "E") = TextBox5.Value
    Sh.Cells(i, "F") = TextBox6.Value
    Sh.Cells(i, "G") = TextBox7.Value
    Sh.Cells(i, "H") = TextBox8.Value
    Sh.Cells(i, "I") = TextBox9.Value
 
    For Each Nesne In UserForm1.Controls
         If TypeOf Nesne Is MSForms.TextBox Then Nesne.Value = ""
    Next
 
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub TextBox2_Change()
    TextBox2.Value = BKH(TextBox2.Value, 3)
End Sub

Private Sub TextBox3_Change()
    TextBox3.Value = BKH(TextBox3.Value, 3)
End Sub

Private Sub UserForm_Initialize()
    Dim i   As Long
    Dim Sat As Long
    Dim sp  As Worksheet
 
    Set sp = Sheets("Parametre")
    Sat = sp.Cells.Find("*", , , , xlByRows, xlPrevious).Row
 
    For i = 2 To Sat
        If Not sp.Cells(i, "A") = "" Then ComboBox1.AddItem sp.Cells(i, "A")
        If Not sp.Cells(i, "B") = "" Then ComboBox2.AddItem sp.Cells(i, "B")
    Next i
 
End Sub

Function BKH(Sozcuk As String, Optional Tip As Integer) As String
    'Tip    1. Küçük Harf
    '       2. Büyük Harf
    '       3. Yazım Düzeni
 
    If Tip = 1 Then
        BKH = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tip = 2 Then
        BKH = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        BKH = Application.WorksheetFunction.Proper(Sozcuk)
    End If
 
End Function

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

 

[simsek3131]

eline emeğine sağlık üstad çok teşekkür ederim

 

[Necdet]

eline emeğine sağlık üstad çok teşekkür ederim

Güle güle kullanınız.