• 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

Son düzenleme:
S

Skorpiyon

Misafir
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
 
V

vaybeeee

Katılım
21 Mart 2011
Mesajlar
43
Excel Vers. ve Dili
Excel 2003 Ingilizce
Ş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.
 
S

Skorpiyon

Misafir
Bende herhangi bir hata vermiyor. Tam olarak ne yaptığınızda bu hatayı alıyorsunuz ?
 
V

vaybeeee

Katılım
21 Mart 2011
Mesajlar
43
Excel Vers. ve Dili
Excel 2003 Ingilizce
Ş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.
Üst