• DİKKAT

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

Satirlari nasil degistirebilirim?

V

vaybeeee

Katılım
21 Mart 2011
Mesajlar
43
Excel Vers. ve Dili
Excel 2003 Ingilizce
Yazma ve gösteriyi A2 degilde, B5 den nasil baslatabilirim?
Yani 1 Saga ve 3 asagiya nasil oluyor?

Bir türlü anlamiyorum Listbox'un gösteri veya verilerini nasil degistirebilecegimi.
Yardimci olabilirseniz buna cok sevinirim.
Programa ilk giriş ŞİFRESİ : 1234
 

Ekli dosyalar

  • Adres-Telefon Rehberi.rar
    Adres-Telefon Rehberi.rar
    157.3 KB · Görüntüleme: 32
  • b5 den sonra yazilimin baslamasini istiyorum.jpg
    b5 den sonra yazilimin baslamasini istiyorum.jpg
    15.3 KB · Görüntüleme: 11
Son düzenleme:
Sayın vaybeeee,

İstediğiniz bu ise, aşağıdaki kısmı belirtilen şekilde düzeltin.

Private Sub UserForm_Initialize()
On Error Resume Next
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("veri").Range("B:B"))
For Each MyRange In Sheets("veri").Range("B6:B" & noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next
ComboBox1.SetFocus
CommandButton5.Enabled = False
CommandButton94.Enabled = False
CommandButton62.Enabled = False
ComboBox3.RowSource = "giriş!BA1:BA5"
ComboBox4.RowSource = "iller!A1:A100"
TextBox17 = Sheets("veri").Range("AB1").Value
TextBox18 = Sheets("veri").Range("AC1").Value
End Sub
 
Şaban Sertkaya' Alıntı:
Sayın vaybeeee,

İstediğiniz bu ise, aşağıdaki kısmı belirtilen şekilde düzeltin.

Private Sub UserForm_Initialize()
On Error Resume Next
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("veri").Range("B:B"))
For Each MyRange In Sheets("veri").Range("B6:B" & noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next
ComboBox1.SetFocus
CommandButton5.Enabled = False
CommandButton94.Enabled = False
CommandButton62.Enabled = False
ComboBox3.RowSource = "giriş!BA1:BA5"
ComboBox4.RowSource = "iller!A1:A100"
TextBox17 = Sheets("veri").Range("AB1").Value
TextBox18 = Sheets("veri").Range("AC1").Value
End Sub
Genişletmek için tıkla ...

Selam Saban bey,

Yardimiz icin cok tesekkür ederim.

Böyle ama MsgBoxda "Bu Kayýt numarasý bulundu." görünüp hicbir veri yeni yazilmiyor.
 
Bende herhangi bir hata vermiyor. Tam olarak ne yaptığınızda bu hatayı alıyorsunuz ?
 
Şaban Sertkaya' Alıntı:
Kodda hata. Düzeltme...
Genişletmek için tıkla ...

Belki böyle yardimci olabilirsiniz:
Degisilmesi gereken Userform'daki kod:

Ekli dosyayı görüntüle Adres-Telefon Rehberi.rar

Kod: 
Option Explicit

'API functions
Private Declare Function GetWindowLong Lib "user32" _
                                       Alias "GetWindowLongA" _
                                       (ByVal hWnd As Long, _
                                        ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
                                       Alias "SetWindowLongA" _
                                       (ByVal hWnd As Long, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
                                      (ByVal hWnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal x As Long, _
                                       ByVal Y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
                                    Alias "FindWindowA" _
                                    (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
                                         () As Long
Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" _
                                     (ByVal hWnd As Long) As Long


'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&


Private Sub ComboBox1_Change()
ComboBox1 = (ComboBox1)
ComboBox1 = Evaluate("=PROPER(" & """" & ComboBox1 & """" & ")")
End Sub

Private Sub ComboBox2_Change()
On Error Resume Next
ComboBox2 = (ComboBox2)
Dim MyRange As Range
Dim noA As Integer
ListBox1.Clear
noA = WorksheetFunction.CountA(Sheets("veri").Range("B:B"))
For Each MyRange In Sheets("veri").Range("B2:B" & noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next
End Sub


Private Sub CommandButton1_Click()
On Error Resume Next
Sheets("veri").Select
    Dim bak As Range '****
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = ComboBox1.Value Then
            MsgBox "Bu Kayýt numarasý bulundu."
            Exit Sub
        End If
           If ComboBox1.Text = "" Then
    MsgBox "Lütfen önce isim girin...", , "Kayýt Hatasý!!!"
    Exit Sub
    End If
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydýnýz 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
     Cells(say + 1, 3).Value = ComboBox3.Value
    Cells(say + 1, 4).Value = TextBox2.Value
    Cells(say + 1, 5).Value = ComboBox4.Value
    Cells(say + 1, 6).Value = TextBox3.Value
    Cells(say + 1, 7).Value = TextBox4.Value
    Cells(say + 1, 8).Value = TextBox5.Value
    Cells(say + 1, 9).Value = TextBox6.Value
    Cells(say + 1, 10).Value = TextBox7.Value
    Cells(say + 1, 11).Value = TextBox8.Value
    Cells(say + 1, 12).Value = TextBox9.Value
    Cells(say + 1, 13).Value = TextBox10.Value
    Cells(say + 1, 14).Value = TextBox11.Value
    Cells(say + 1, 15).Value = TextBox12.Value
    Cells(say + 1, 16).Value = TextBox13.Value
    Cells(say + 1, 17).Value = TextBox14.Value
    Cells(say + 1, 18).Value = TextBox15.Value
    Cells(say + 1, 19).Value = TextBox16.Value
    MsgBox "Yeni Kayýt Baþarýyla Yapýlmýþtýr.Ýyi Çalýþmalar Dilerim", vbInformation, "Sn.  " & Application.UserName

    Range("A2:A65500").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        '************************
    Range("B2:U65500").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
    CommandButton5_Click
    ComboBox2_Change
    ComboBox1.SetFocus
    Unload UserForm1
    UserForm1.Show
End Sub

Private Sub CommandButton13_Click()
On Error Resume Next
    If MsgBox("Programdan Çýkmak Ýstiyor musunuz? ?", vbYesNo, "Dikkat") = vbNo Then Exit Sub
 
   
     MsgBox "LÜTFEN Bekleyiniz.....Verileriniz Kaydedilip Program Kapatýlacak...", vbCritical
  Unload UserForm1
    Workbooks("Adres-Telefon Rehberi.XLS").Save
    Application.Visible = True
    Application.Quit
    
End Sub

Private Sub CommandButton2_Click()
Application.Visible = True
    Unload UserForm1
End Sub

Private Sub CommandButton5_Click()
ComboBox1.Value = ""
    ComboBox2.Value = ""
    ComboBox3.Value = ""
    ComboBox4.Value = ""
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox4.Value = ""
    TextBox5.Value = ""
    TextBox6.Value = ""
    TextBox7.Value = ""
    TextBox8.Value = ""
    TextBox9.Value = ""
    TextBox10.Value = ""
    TextBox11.Value = ""
    TextBox12.Value = ""
    TextBox13.Value = ""
    TextBox14.Value = ""
    TextBox15.Value = ""
    TextBox16.Value = ""
    CommandButton5.Enabled = False
    CommandButton94.Enabled = False
CommandButton62.Enabled = False
CommandButton1.Enabled = True
    ComboBox1.SetFocus
End Sub







Private Sub CommandButton60_Click()
MsgBox "Adres-Telefon REHBERÝ 2007" & vbCrLf & " " & vbCrLf & "Hazýrlayan: H.Ýsmail Küçükþengün, E-mail:kucuksengun@hotmail.com" & vbCrLf & " " & vbCrLf & "Kullaným kýsýtlamasý yoktur.Ücretsiz olup,ticari amaçla yayýnlanamaz,daðýtýlamaz." & vbCrLf & "Lütfen programda gördüðünüz eksiklikleri ve Önerilerinizi bildiriniz. Teþekkür ederiz.", vbInformation, "Pogram Hakkýnda"
End Sub




Private Sub CommandButton62_Click()
On Error Resume Next
Sheets("veri").Select
    Dim bos As Range
    If TextBox1.Text = "sýra no" Then
    MsgBox "sýra no Deðeri deðiþtirilemez program tarafýndan kullanýlýyor...", , "Deðiþtir Hatasý!!!"
    Exit Sub
    End If
    For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then
            MsgBox "Önce aradýðýnýz veriyi BUL ile bulmalýsýnýz"
            Exit Sub
        End If
    Next bos
     If MsgBox("Seçilen kiþi - Firmaya  ait kayýt  bilgileri deðiþtirilecek, Ýstiyor musunuz?", vbQuestion + vbYesNo, "Dikkat") = vbYes Then
     If TextBox1 = "" Or ComboBox1 = "" Then
        MsgBox "Adý Soyadý listesinden bir Kiþi seçmelisiniz"
    Else
    ActiveCell.Value = ComboBox1.Value
    ActiveCell.Offset(0, 1).Value = ComboBox3.Value
    ActiveCell.Offset(0, 2).Value = TextBox2.Value
     ActiveCell.Offset(0, 3).Value = ComboBox4.Value
      ActiveCell.Offset(0, 4).Value = TextBox3.Value
    ActiveCell.Offset(0, 5).Value = TextBox4.Value
    ActiveCell.Offset(0, 6).Value = TextBox5.Value
    ActiveCell.Offset(0, 7).Value = TextBox6.Value
    ActiveCell.Offset(0, 8).Value = TextBox7.Value
    ActiveCell.Offset(0, 9).Value = TextBox8.Value
    ActiveCell.Offset(0, 10).Value = TextBox9.Value
    ActiveCell.Offset(0, 11).Value = TextBox10.Value
    ActiveCell.Offset(0, 12).Value = TextBox11.Value
    ActiveCell.Offset(0, 13).Value = TextBox12.Value
    ActiveCell.Offset(0, 14).Value = TextBox13.Value
    ActiveCell.Offset(0, 15).Value = TextBox14.Value
    ActiveCell.Offset(0, 16).Value = TextBox15.Value
    ActiveCell.Offset(0, 17).Value = TextBox16.Value
    MsgBox "" & ComboBox1.Value & " isimli Kayda ait Bilgiler GÜNCELLEÞTÝRÝLMÝÞTÝR.Ýyi Çalýþmalar Dilerim.", vbInformation, "Adres-Telefon REHBERÝ"
    End If
    ComboBox1.RowSource = "Veri!B1:B" & 1
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
   
    ComboBox2.Value = "0"
    CommandButton5_Click
     
 End If
   
End Sub

Private Sub CommandButton94_Click()
On Error Resume Next
Sheets("veri").Select
    If TextBox1.Text = "sýra no" Then
    MsgBox "sýra no Deðeri silinemez program tarafýndan kullanýlýyor...", , "Sil Hatasý!!!"
    Exit Sub
    End If
     Dim say As Integer
    Dim i As Integer
    Dim bos As Range
    For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then
            MsgBox "Önce aradýðýnýz veriyi BUL ile bulmalýsýnýz"
            Exit Sub
        End If
      Next bos
   If MsgBox("Seçilen kiþi - Firmaya  ait kayýt  tamamen Silinecek, Silmek Ýstiyor musunuz?", vbQuestion + vbYesNo, "Dikkat") = vbYes Then
   
 
     

 
   

    Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 20).Address(False, False)).Delete Shift:=xlUp
    MsgBox " " & ComboBox1.Value & " isimli kayda ait Tüm Bilgiler Silinmiþtir.", vbInformation, "Adres-Telefon REHBERÝ"
    say = WorksheetFunction.CountA(Range("A2:A65500"))
    For i = 1 To say
        Cells(i + 1, 1) = i
    Next i
    
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
    CommandButton5_Click
    ComboBox2_Change
    ComboBox1.SetFocus
    Unload UserForm1
    UserForm1.Show
   End If
End Sub

Private Sub CommandButton95_Click()
Sheets("veri").Select
On Error Resume Next
    [aa4] = ComboBox1.Text
    [ac4] = ComboBox3.Text
    [ae4] = TextBox2.Text
    [ag4] = ComboBox4.Text
    [ac12] = TextBox3.Text
    [ac8] = TextBox4.Text
    [ae8] = TextBox5.Text
    [ag8] = TextBox6.Text
    [ae12] = TextBox7.Text
    [ag12] = TextBox8.Text
    [aa15] = TextBox9.Text
    [aa7] = TextBox10.Text
    [aa11] = TextBox11.Text
    [ac15] = TextBox12.Text
    [aa18] = TextBox13.Text
    [ae15] = TextBox14.Text
    [ag15] = TextBox15.Text
    [aa22] = TextBox16.Text
    
    Range("AF1:AL24").Select
    ActiveSheet.PageSetup.PrintArea = "$AA$1:$AG$24"
Application.ScreenUpdating = False
Application.Visible = True
Application.ScreenUpdating = True
UserForm1.Hide

'
Sheets(Array("veri")).PrintPreview
Application.ScreenUpdating = False
Application.Visible = False
Application.ScreenUpdating = True
Sheets("veri").Select
UserForm1.Show
End Sub

Private Sub ListBox1_Click()
On Error Resume Next
Sheets("veri").Select
Dim x As Integer
x = Sheets("veri").Range("B:B").Cells.Find(what:=ListBox1, LookIn:=xlValues).Row
ComboBox1.Value = ListBox1
ComboBox1 = Sheets("veri").Cells(x, 2)
  Dim bak As Range
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
            TextBox1.Value = ActiveCell.Offset(0, -1).Value
            ComboBox3.Value = ActiveCell.Offset(0, 1).Value
            TextBox2.Value = ActiveCell.Offset(0, 2).Value
             ComboBox4.Value = ActiveCell.Offset(0, 3).Value
               TextBox3.Value = ActiveCell.Offset(0, 4).Value
            TextBox4.Value = ActiveCell.Offset(0, 5).Value
            TextBox5.Value = ActiveCell.Offset(0, 6).Value
            TextBox6.Value = ActiveCell.Offset(0, 7).Value
            TextBox7.Value = ActiveCell.Offset(0, 8).Value
            TextBox8.Value = ActiveCell.Offset(0, 9).Value
            TextBox9.Value = ActiveCell.Offset(0, 10).Value
            TextBox10.Value = ActiveCell.Offset(0, 11).Value
            TextBox11.Value = ActiveCell.Offset(0, 12).Value
            TextBox12.Value = ActiveCell.Offset(0, 13).Value
            TextBox13.Value = ActiveCell.Offset(0, 14).Value
            TextBox14.Value = ActiveCell.Offset(0, 15).Value
            TextBox15.Value = ActiveCell.Offset(0, 16).Value
            TextBox16.Value = ActiveCell.Offset(0, 17).Value
             CommandButton5.Enabled = True
    CommandButton94.Enabled = True
CommandButton62.Enabled = True
CommandButton1.Enabled = False
            Exit Sub
        End If
    Next bak
    CommandButton5.Enabled = True
    CommandButton94.Enabled = True
CommandButton62.Enabled = True
CommandButton1.Enabled = False
    ComboBox2.SetFocus



End Sub

Private Sub TextBox3_Change()
If Len(TextBox3.Text) >= 15 Then TextBox3 = Left(TextBox3, 15)
If Len(TextBox3.Text) < 10 Then
TextBox3 = Replace(TextBox3, " ", "")
Else
TextBox3.Text = Format(TextBox3, "(###) ###-##-##")
End If
End Sub



Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox3 = Format(TextBox3, "(###) ###-##-##")
End Sub

Private Sub TextBox4_Change()
If Len(TextBox4.Text) >= 15 Then TextBox4 = Left(TextBox4, 15)
If Len(TextBox4.Text) < 10 Then
TextBox4 = Replace(TextBox4, " ", "")
Else
TextBox4.Text = Format(TextBox4, "(###) ###-##-##")
End If
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox4 = Format(TextBox4, "(###) ###-##-##")
End Sub

Private Sub TextBox5_Change()
If Len(TextBox5.Text) >= 15 Then TextBox5 = Left(TextBox5, 15)
If Len(TextBox5.Text) < 10 Then
TextBox5 = Replace(TextBox5, " ", "")
Else
TextBox5.Text = Format(TextBox5, "(###) ###-##-##")
End If
End Sub

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox5 = Format(TextBox5, "(###) ###-##-##")
End Sub

Private Sub TextBox6_Change()
If Len(TextBox6.Text) >= 15 Then TextBox6 = Left(TextBox6, 15)
If Len(TextBox6.Text) < 10 Then
TextBox6 = Replace(TextBox6, " ", "")
Else
TextBox6.Text = Format(TextBox6, "(###) ###-##-##")
End If
End Sub

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox6 = Format(TextBox6, "(###) ###-##-##")
End Sub

Private Sub TextBox7_Change()
If Len(TextBox7.Text) >= 15 Then TextBox7 = Left(TextBox7, 15)
If Len(TextBox7.Text) < 10 Then
TextBox7 = Replace(TextBox7, " ", "")
Else
TextBox7.Text = Format(TextBox7, "(###) ###-##-##")
End If
End Sub

Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox7 = Format(TextBox7, "(###) ###-##-##")
End Sub




Private Sub AddMinimiseButton()
'//Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLong(hWnd, GWL_STYLE, _
                       GetWindowLong(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub





Private Sub UserForm_Initialize()
On Error Resume Next
Dim MyRange As Range
Dim noA As Integer
noA = WorksheetFunction.CountA(Sheets("veri").Range("B:B"))
For Each MyRange In Sheets("veri").Range("B2:B" & noA)
If Left(LCase(MyRange), Len(ComboBox2)) = LCase(ComboBox2) Then ListBox1.AddItem (MyRange)
Next

ComboBox1.SetFocus
CommandButton5.Enabled = False
    CommandButton94.Enabled = False
CommandButton62.Enabled = False
ComboBox3.RowSource = "veri!AO5:AO8"
ComboBox4.RowSource = "veri!AQ5:AQ100"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode <> 1 Then Cancel = True
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst