Numeric değil Karakter girmek istiyorum

I

ipkisiyamaksosis

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Merhabalar,

Sheet1'de Stok yazan yere Var yada Yok yazdırmak istiyorum. Ancak makro'da If Isnumeric yazdığı için sadece rakam girebiliyorum sabahtan beri araştırıyorum nasıl Text girdirebilirim diye ama bir türlü bulamadım.

Bana yardımcı olursanız çok sevinirim. Teşekkürler...

Private Sub CommandButton1_Click()

Dim ctrl As Control
Dim mk&, fy&, st&

With Sheets("Sheet1")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If IsNumeric(ctrl) Then .Cells(arr(mk), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 6) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 7) = "TxtStok" Then
st = st + 1
If IsNumeric(ctrl) Then .Cells(arr(st), 4) = CDbl(ctrl)
End If
Next
End With
 

Ekli dosyalar

uzmanamele

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
merhaba

bu şekilde dener misiniz
Kod: 
If Isnumeric
Kod: 
If Not Isnumeric
 
I

ipkisiyamaksosis

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Öncelikle cevap verdiğiniz için teşekkür ederim.

Ben daha önce denemiştim If not isnumeric olarak fakat olmamıştı. Şimdi tekrar denedim ama nafile.

Run-time error "13":

Type mismatch

yazıyor. Debug dediğimde ise aşağıdaki kodun kırmızı ile işaretlediğim yerde hata veriyor..

If Not IsNumeric(ctrl) Then .Cells(arr(st), 4) = CDbl(ctrl)
 
I

ipkisiyamaksosis

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Arkadaşlar çok zor durumdayım bulamıyorum bir türlü. Mutlaka bunu bilen biri vardır. Lütfen yardımınıza ihtiyacım var.

Teşekkürler...
 
I

ipkisiyamaksosis

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Lütfen biri bana yardım etsin. Çözemiyorum bu durumu. Neden kimse yardım etmiyor anlamıyorum.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,222
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Kayıt için kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod: 
Private Sub CommandButton1_Click()
    Dim ctrl As Control
    Dim mk&, fy&, st&
    
    With Sheets("Sheet1")
        For Each ctrl In Frame1.Controls
            If Left(ctrl.Name, 9) = "TxtMiktar" Then
                mk = mk + 1
                If IsNumeric(ctrl) Then .Cells(arr(mk), 5) = CDbl(ctrl)
            ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
                fy = fy + 1
                If IsNumeric(ctrl) Then .Cells(arr(fy), 6) = CDbl(ctrl)
            ElseIf Left(ctrl.Name, 7) = "TxtStok" Then
                st = st + 1
                [COLOR=red]If Not IsNumeric(ctrl) Then .Cells(arr(st), 4) = ctrl[/COLOR]
            End If
        Next
    End With
TxtMiktar = ""
TxtFiyat = ""
TxtStok = ""
ComboBox1.Text = ""
ComboBox1.SetFocus
End Sub
 
I

ipkisiyamaksosis

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Sorunum halloldu çok teşekkür ederim. Ben CDbl'yi silmeyi her defasında unutuyormuşum şimdi istediğim gibi oldu.

Benim şimdi bir küçük sorunum daha var yardımcı olursanız çok sevinirim. Forum'da bulamadım.

Şimdi ben bu makro'da otomatik çıkan Textbox'ların boş geçmemesini istiyorum. Makrom aşağıdaki gibidir. Kırmızı ile işaretlediğim bölümü ekledim boş geçmemesi için fakat doluyken'de aynı uyarıyı veriyor.

Private Sub CommandButton1_Click()

Dim ctrl As Control
Dim mk&, fy&, st&

With Sheets("Sheet1")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If IsNumeric(ctrl) Then .Cells(arr(mk), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 6) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 7) = "TxtStok" Then
st = st + 1
If IsNumeric(ctrl) Then .Cells(arr(st), 4) = CDbl(ctrl)
End If
Next
End With

If TextBox = Empty Then
MsgBox "<Boşluk> BOŞ..."
Exit Sub
End If

TxtMiktar = ""
TxtFiyat = ""
TxtStok = ""
ComboBox1.Text = ""
ComboBox1.SetFocus
End Sub
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,222
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki şekilde kullanabilirsiniz. Form üzerindeki bütün TextBox nesneleri için aynı uyarıyı verir.

Kod: 
Private Sub CommandButton1_Click()
 
    Dim ctrl As Control
    Dim mk&, fy&, st&
 
    With Sheets("Sheet1")
        For Each ctrl In Frame1.Controls
[COLOR=red]           If ctrl = Empty Then[/COLOR]
[COLOR=red]           MsgBox "<BOŞLUK> BOŞ ..."[/COLOR]
[COLOR=red]           Exit Sub[/COLOR]
[COLOR=red]           End If[/COLOR]
            
            If Left(ctrl.Name, 9) = "TxtMiktar" Then
                mk = mk + 1
                If IsNumeric(ctrl) Then .Cells(arr(mk), 5) = CDbl(ctrl)
            ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
                fy = fy + 1
                If IsNumeric(ctrl) Then .Cells(arr(fy), 6) = CDbl(ctrl)
            ElseIf Left(ctrl.Name, 7) = "TxtStok" Then
                st = st + 1
                If Not IsNumeric(ctrl) Then .Cells(arr(st), 4) = ctrl
            End If
        Next
    End With
    TxtMiktar = ""
    TxtFiyat = ""
    TxtStok = ""
    ComboBox1.Text = ""
    ComboBox1.SetFocus
End Sub
 
T

Tamermaster

Misafir
run-time error Automation hatası alıyorum

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _
ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2
Dim arr() As Long

Private Sub CommandButton1_Click()

Dim ctrl As Control
Dim mk&, fy&, ad&
If OptionButton1.Value = True Then
With Sheets("KırtGuv")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If
If OptionButton2.Value = True Then
With Sheets("Vergi")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If
If OptionButton3.Value = True Then
With Sheets("Reklam")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton4.Value = True Then
With Sheets("BakımOnarım")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton5.Value = True Then
With Sheets("Gıda")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If
If OptionButton6.Value = True Then
With Sheets("Yakıt")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton7.Value = True Then
With Sheets("Masraf")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton8.Value = True Then
With Sheets("Personel")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton9.Value = True Then
With Sheets("İçki")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If
If OptionButton10.Value = True Then
With Sheets("Banka")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton11.Value = True Then
With Sheets("KargoYol")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If (ctrl) > "" Then .Cells(arr(ad), 6) = (ctrl)
End If
Next
End With
End If

If OptionButton12.Value = True Then
With Sheets("30")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If (ctrl) > "" Then .Cells(arr(mk), 4) = CDate(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 6) = "TxtAdi" Then
ad = ad + 1
If Not IsNumeric(ctrl) Then .Cells(arr(ad), 6) = (ctrl)

End If
Next
End With
End If
End Sub

Private Sub ComboBox1_Change()
Dim SatirSay As Integer
Dim y As Integer
Dim i As Integer
Dim ctrl As Control

Frame1.Controls.Clear
If OptionButton1.Value = True Then
With Sheets("KırtGuv")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Kırtasiye Ve Güvenlik__KOD_________TARİH_________ÖDEME_____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton2 = True Then
With Sheets("Vergi")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Vergi Ödemeleri____KOD___________TARİH__________ÖDEME____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton3.Value = True Then
With Sheets("Reklam")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Reklam Giderleri____KOD____________TARİH________ÖDEME_____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton4.Value = True Then
With Sheets("BakımOnarım")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Bakım Onarım_____KOD____________TARİH_________ÖDEME______________AÇIKLAMA"
End If
Next i
End With
End If

If OptionButton5 = True Then
With Sheets("Gıda")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Gıda Giderleri____KOD_____________TARİH__________ÖDEME____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton6.Value = True Then
With Sheets("Yakıt")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Yakıt Giderleri____KOD______________TARİH________ÖDEME_____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton7.Value = True Then
With Sheets("Masraf")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Masraflar_____KOD_______________TARİH_________ÖDEME______________AÇIKLAMA"
End If
Next i
End With
End If

If OptionButton8.Value = True Then
With Sheets("Personel")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Personel Ücret Gider___KOD__________TARİH_________ÖDEME______________AÇIKLAMA"
End If
Next i
End With
End If

If OptionButton9 = True Then
With Sheets("İçki")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "İçki Giderleri____KOD______________TARİH__________ÖDEME____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton10.Value = True Then
With Sheets("Banka")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Banka Masraf Kredi___KOD____________TARİH________ÖDEME_____________AÇIKLAMA"
End If
Next i
End With
End If
If OptionButton11.Value = True Then
With Sheets("KargoYol")
For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then
Call Tablo_Olustur(SatirSay)
End If

For i = 2 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Frame1.Caption = "Kargo Ve Yol Masrafı__KOD____________TARİH_________ÖDEME______________AÇIKLAMA"
End If
Next i

End With
End If
If OptionButton12.Value = True Then
With Sheets("30")
For i = 1 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
SatirSay = SatirSay + 1
ReDim Preserve arr(1 To SatirSay)
arr(SatirSay) = i
End If
Next i
If SatirSay > 0 Then Call Tablo_Olustur(SatirSay)

For i = 1 To .Cells(400, 1).End(xlUp).Row
If CStr(.Cells(i, 1)) = ComboBox1 Then
y = y + 1
Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
Me.Controls("TxtMiktar" & y).Value = .Cells(i, 4)
Me.Controls("TxtFiyat" & y).Value = .Cells(i, 5)
Me.Controls("TxtAdi" & y).Value = .Cells(i, 6)
Me.Controls("LblAda" & y).Caption = .Cells(i, 7)
Me.Controls("LblAdb" & y).Caption = .Cells(i, 8)
Me.Controls("LblAdc" & y).Caption = .Cells(i, 9)
Frame1.Caption = "Çekler__KOD_______TARİH_____ÖDEME___________AÇIKLAMA"
End If
Next i
End With
End If
End Sub
Private Sub OptionButton12_Click()
If OptionButton12.Value = True Then ComboBox1.RowSource = "30!a2:a50"
End Sub
Private Sub OptionButton11_Click()
If OptionButton11.Value = True Then ComboBox1.RowSource = "KargoYol!A73:A74"
End Sub
Private Sub Tablo_Olustur(ByRef Olusturulacak_Satir_Sayisi As Integer)
Dim txT As MSForms.TextBox
Dim lbL As MSForms.Label

Dim ustKod As Double
Dim ustKtg As Double
Dim ustMik As Double
Dim ustFyt As Double
Dim ustAdi As Double
Dim ustAda As Double
Dim ustAdb As Double
Dim ustAdc As Double

Dim soL As Double
Dim yuK As Double
Dim geN As Double

ustMik = 2: ustFyt = 2: ustKod = 2: ustKtg = 2: ustAdi = 2: ustAda = 2: ustAdb = 2: ustAdc = 2: soL = 2: yuK = 18: geN = 55

With Frame1
For i = 1 To Olusturulacak_Satir_Sayisi
If OptionButton12.Value = False Then
Set lbL = .Controls.Add("Forms.Label.1", "LblKod" & i, True)
With lbL
.Caption = "LblKod" & i
.Top = ustKod + 1
.Left = soL
.Height = yuK
.Width = geN
ustKod = ustKod + .Height + 1
soL = soL + geN + 1
End With

Set lbL = .Controls.Add("Forms.Label.1", "LblKtg" & i, True)
With lbL
.Caption = "LblKtg" & i
.Top = ustKtg + 1
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustKtg = ustKtg + .Height + 1
soL = soL + geN + 1
End With

Set txT = .Controls.Add("Forms.TextBox.1", "TxtMiktar" & i, True)
With txT
.Top = ustMik
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustMik = ustMik + .Height + 1
soL = soL + geN + 1

End With

Set txT = .Controls.Add("Forms.TextBox.1", "TxtFiyat" & i, True)
With txT
.Top = ustFyt
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustFyt = ustFyt + .Height + 1
soL = soL + geN + 1

End With

Set txT = .Controls.Add("Forms.TextBox.1", "TxtAdi" & i, True)
With txT
.Top = ustAdi
.Left = soL ' + geN + 1
.Height = yuK
.Width = 150

ustAdi = ustAdi + .Height + 1
soL = soL + geN + 1

End With
End If
If OptionButton12.Value = True Then 'Çekler

Set lbL = .Controls.Add("Forms.Label.1", "LblKod" & i, True)
With lbL
.Caption = "LblKod" & i
.Top = ustKod + 1
.Left = soL
.Height = yuK
.Width = geN
ustKod = ustKod + .Height + 1
soL = soL + geN + 1
End With

Set lbL = .Controls.Add("Forms.Label.1", "LblKtg" & i, True)
With lbL
.Caption = "LblKtg" & i
.Top = ustKtg + 1
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustKtg = ustKtg + .Height + 1
soL = soL + geN + 1
End With


Set lbL = .Controls.Add("Forms.Label.1", "LblAda" & i, True)
With lbL
.Caption = "LblAda" & i
.Top = ustAda + 2
.Left = soL ' + geN + 1
.Height = yuK
.Width = 60

ustAda = ustAda + .Height + 1
soL = soL + geN + 1

End With
Set lbL = .Controls.Add("Forms.Label.1", "LblAdb" & i, True)
With lbL
.Caption = "LblAdb" & i
.Top = ustAdb + 2
.Left = soL ' + geN + 1
.Height = yuK
.Width = 60

ustAdb = ustAdb + .Height + 1
soL = soL + geN + 1

End With
Set lbL = .Controls.Add("Forms.Label.1", "LblAdc" & i, True)
With lbL
.Caption = "LblAdc" & i
.Top = ustAdc + 2
.Left = soL ' + geN + 1
.Height = yuK
.Width = 85

ustAdc = ustAdc + .Height + 1
soL = soL + geN + 1

End With
Set txT = .Controls.Add("Forms.TextBox.1", "TxtMiktar" & i, True)
With txT
.Top = ustMik
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustMik = ustMik + .Height + 1
soL = soL + geN + 1

End With

Set txT = .Controls.Add("Forms.TextBox.1", "TxtFiyat" & i, True)
With txT
.Top = ustFyt
.Left = soL ' + geN + 1
.Height = yuK
.Width = geN
ustFyt = ustFyt + .Height + 1
soL = soL + geN + 1

End With

Set txT = .Controls.Add("Forms.TextBox.1", "TxtAdi" & i, True)
With txT
.Top = ustAdi
.Left = soL ' + geN + 1
.Height = yuK
.Width = 150

ustAdi = ustAdi + .Height + 1
soL = soL + geN + 1

End With
Else: End If
soL = 2
Next i

.ScrollBars = fmScrollBarsVertical
.ScrollHeight = (i - 1) * (19) + 5
End With
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub Label1000_Click()

Unload Me
Tahsilat.Show
End Sub

Private Sub Label1001_Click()
Dim xl As Long
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Dim rtn As Long
rtn = GetWindowLong(hWndForm, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWndForm, GWL_EXSTYLE, rtn
For i = 255 To 0 Step -5
SetLayeredWindowAttributes hWndForm, 0, i, LWA_ALPHA
Sleep 20
DoEvents
DrawMenuBar hWndForm
SetFocus hWndForm
Next i
Unload Me
Etk.Show
End Sub

Private Sub Label1002_Click()

End Sub

Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then ComboBox1.RowSource = "KırtGuv!A97:A98"
End Sub

Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then ComboBox1.RowSource = "Vergi!A7:A98"
End Sub
Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then ComboBox1.RowSource = "Reklam!A2"
End Sub
Private Sub OptionButton4_Click()
If OptionButton4.Value = True Then ComboBox1.RowSource = "BakımOnarım!A73:a74"
End Sub
Private Sub OptionButton5_Click()
If OptionButton5.Value = True Then ComboBox1.RowSource = "Gıda!A73:A74"
End Sub
Private Sub OptionButton6_Click()
If OptionButton6.Value = True Then ComboBox1.RowSource = "Yakıt!A73:A74"
End Sub
Private Sub OptionButton7_Click()
If OptionButton7.Value = True Then ComboBox1.RowSource = "Masraf!A73:a74"
End Sub
Private Sub OptionButton8_Click()
If OptionButton8.Value = True Then ComboBox1.RowSource = "Personel!A73:a74"
End Sub
Private Sub OptionButton9_Click()
If OptionButton9.Value = True Then ComboBox1.RowSource = "İçki!A73:A74"
End Sub
Private Sub OptionButton10_Click()
If OptionButton10.Value = True Then ComboBox1.RowSource = "Banka!A73:A74"
End Sub

'Private Sub OptionButton12_Click()
'If OptionButton12.Value = True Then ComboBox1.RowSource = "Etkinlik!cv1:cv50"
'End Sub

Private Sub UserForm_Initialize()



Label1002.Caption = Now

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst