DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[SIZE="2"]Private Sub CommandButton8_Click()
sor = MsgBox("Değiştirmek istediğinizden eminmisiniz?", vbYesNo)
If sor = vbNo Then Exit Sub
Degistirilecek_Satir = İŞLEMGİRİŞEKRANI.ListIndex + 2
Sheets("VERİ").Range("A" & Degistirilecek_Satir).Value = TextBox1.Text 'SIRA
Sheets("VERİ").Range("B" & Degistirilecek_Satir).Value = TextBox2.Text 'TARİH
Sheets("VERİ").Range("D" & Degistirilecek_Satir).Value = TextBox3.Text 'ADISOYADI
Sheets("VERİ").Range("F" & Degistirilecek_Satir).Value = TextBox4.Text 'MERKEZNO
Sheets("VERİ").Range("H" & Degistirilecek_Satir).Value = TextBox5.Text 'HESAP NO
[COLOR="Red"] If IsNumeric(TextBox6) = True Then Sheets("VERİ").Range("I" & Degistirilecek_Satir).Value = CDbl(TextBox6)
If IsNumeric(TextBox7) = True Then Sheets("VERİ").Range("L" & Degistirilecek_Satir).Value = CDbl(TextBox7)
If IsNumeric(TextBox8) = True Then Sheets("VERİ").Range("J" & Degistirilecek_Satir).Value = CDbl(TextBox8)
If IsNumeric(TextBox9) = True Then Sheets("VERİ").Range("M" & Degistirilecek_Satir).Value = CDbl(TextBox9)
If IsNumeric(TextBox11) = True Then Sheets("VERİ").Range("N" & Degistirilecek_Satir).Value = CDbl(TextBox11)
If IsNumeric(TextBox12) = True Then Sheets("VERİ").Range("K" & Degistirilecek_Satir).Value = CDbl(TextBox12)
If IsNumeric(TextBox13) = True Then Sheets("VERİ").Range("O" & Degistirilecek_Satir).Value = CDbl(TextBox13)[/COLOR]
Sheets("VERİ").Range("C" & Degistirilecek_Satir).Value = ComboBox1.Text 'SİCİL
Sheets("VERİ").Range("E" & Degistirilecek_Satir).Value = ComboBox2.Text 'MERKEZ ADI
Sheets("VERİ").Range("G" & Degistirilecek_Satir).Value = ComboBox3.Text 'HESAP ADI
'.....
'.... DİĞER KODLAR
'......
[/SIZE] [SIZE="2"]Private Sub TextBox6_Change()
[COLOR="Red"]
[COLOR="Blue"]'......[/COLOR]
With [COLOR="Blue"]TextBox6[/COLOR]
If IsNumeric(.Text) = False Then
.Text = 0
.SelStart = 0
.SelLength = Len([COLOR="Blue"]TextBox6[/COLOR])
End If
End With
[COLOR="Blue"]'......[/COLOR]
[/COLOR]
TextBox12 = Format(CDbl(TextBox6) + CDbl(TextBox8), "#,##0.00")
TextBox13 = Format(CDbl(TextBox6) + CDbl(TextBox8) + CDbl(TextBox7) + CDbl(TextBox9), "#,##0.00")
End Sub [/SIZE][SIZE="2"]Private Sub CommandButton11_Click()
Set FRM = New RAPOR
Unload Me
Set s1 = Sheets("RAPOR")
s1.PageSetup.PrintArea = "$B$1:$J$" & s1.Cells(Rows.Count, "C").End(xlUp).Row
s1.PrintPreview
s1.DisplayAutomaticPageBreaks = False
FRM.Show
End Sub [/SIZE][SIZE="2"]Private Sub CommandButton2_Click()
Set s1 = Sheets("RAPOR")
rw = s1.Cells(Rows.Count, "C").End(xlUp).Row
If rw <= 7 Then MsgBox "RAPOR SAYFASINDA" & vbCrLf & "YAZDIRILACAK VERİ BULUNAMADI": Exit Sub
s1.PageSetup.PrintArea = ""
s1.Range("B1:J" & rw).PrintOut
End Sub [/SIZE][SIZE="2"]Private Sub CommandButton5_Click()
Dim Sat, Son As Integer
[COLOR="Red"]x = Sheets("VERİ").Range("a65536").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("VERİ").Range("A2:A" & x), TextBox1.Text) > 0 Then _
MsgBox "AYNI KAYIT MEVCUT": Exit Sub[/COLOR]
If TextBox3.Value <> "" Then
'...
'...diğer kodlar
'...
[/SIZE]Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)Private Sub UserForm_Terminate()
KillTimer hnd, 0
End Sub
Private Sub MİZAN_Initialize()
With MİZAN.ListBox1
.BackColor = vbWhite
.ColumnCount = 9
.ColumnWidths = "100;100;0;0;60;60;60;60;10"
'...
'...[SIZE="2"]Private Sub CommandButton1_Click()
Set s1 = [COLOR="Red"]Sheets("MİZAN")[/COLOR] 'son eklenen kodlarıda ilgilendirir
s1.Activate
s1.Range([COLOR="Red"]"A2:E"[/COLOR] & Rows.Count).ClearContents
s1.Columns("E:H").NumberFormat = "#,##0.00"
Set c = CreateObject("scripting.filesystemobject")
If c.FileExists(ThisWorkbook.Path & "\MİZAN.xlsm") = False Then
MsgBox "MİZAN.xlsm Dosyası bulunamadı" & vbCrLf & "Verilerin alınacağı MİZAN.xlsm dosyası bu dosyanın yanında olmalı"
Exit Sub
End If
Set con = CreateObject("Adodb.Connection")
Set dt = CreateObject("adodb.recordset")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.Path & "\MİZAN.xlsm" & ";Extended Properties = ""Excel 12.0 Macro;HDR=no"";"
sut = "Select [F1],[F2],[F3],[F4],[F6] From [RAPOR$A2:F65000]"
dt.Open sut, con, 1, 1
s1.Range("A2").CopyFromRecordset dt
dt.Close
Set dt = Nothing
Set con = Nothing
ListBox1.RowSource = "MİZAN!a1:I" & [MİZAN!a65536].End(3).Row
'ListBox1.RowSource = ""
'ListBox1.Clear
'n = 0
'rw = s1.Cells(Rows.Count, "A").End(3).Row
'With ListBox1
'For a = 1 To rw
'If s1.Cells(a, "E") <> "" And s1.Cells(a, "E") > 0 Then
'.AddItem s1.Cells(a, 1)
'For t = 1 To 7
'.list(n, t) = s1.Cells(a, t + 1).Text
'Next
'n = n + 1
'End If
'Next
'End With
[COLOR="Blue"]Application.Calculation = xlCalculationManual
On Error Resume Next
Set s2 = Sheets("VERİ")
v = s2.Cells(Rows.Count, "A").End(3).Row
With Sheets("MİZAN")
For p = 2 To .Cells(Rows.Count, "B").End(3).Row
.Cells(p, "F") = WorksheetFunction.SumIf(s2.Range("H2:H" & v), .Cells(p, "B").Value, s2.Range("O2:O" & v))
If CDbl(.Cells(p, "E")) - CDbl(.Cells(p, "F")) < 0 Then
.Cells(p, "G") = 0
.Cells(p, "H") = CDbl(.Cells(p, "F")) - CDbl(.Cells(p, "E"))
Else
.Cells(p, "G") = CDbl(.Cells(p, "E")) - CDbl(.Cells(p, "F"))
.Cells(p, "H") = 0
End If
Next
End With
Application.Calculation = xlCalculationAutomatic[/COLOR]
End Sub [/SIZE]