Denetim Çalışma programı

[power468]

Saygı değer Üstatlar Kodları Düzeltme konusunda yardımcı olursanız sevinirim


Private Sub CommandButton1_Click()

Application.DisplayAlerts = False
Sheets("TABLO").Select

b = WorksheetFunction.CountA(Sheets("tablo").Range("A:A"))
Sheets("tablo").Range("a" & b + 1).Select
ActiveCell = TextBox11.Value
ActiveCell.Offset(0, 1) = TextBox1.Value
ActiveCell.Offset(0, 2) = TextBox2.Value
ActiveCell.Offset(0, 3) = TextBox3.Value
ActiveCell.Offset(0, 4) = TextBox4.Value
ActiveCell.Offset(0, 5) = ComboBox1.Value
ActiveCell.Offset(0, 6) = TextBox5.Value
ActiveCell.Offset(0, 7) = ComboBox2.Value
ActiveCell.Offset(0, 8) = TextBox6.Value
ActiveCell.Offset(0, 9) = TextBox7.Value
ActiveCell.Offset(0, 10) = ComboBox3.Value
ActiveCell.Offset(0, 11) = TextBox8.Value
ActiveCell.Offset(0, 12) = TextBox9.Value
ActiveCell.Offset(0, 13) = TextBox10.Value
ActiveCell.Offset(0, 14) = ComboBox4.Value




MsgBox "Verileriniz Kaydedildi. Form boşaltılıyor "
For i = 8 To 16
Me.Controls("textbox" & i) = ""

Next i


UserForm_Initialize
ThisWorkbook.Save
Application.DisplayAlerts = True


End Sub




Private Sub CommandButton2_Click()

Application.DisplayAlerts = False
Sheets("TABLO").Select

With Sheets("tablo")
Set bul = .Range("a:a").Find(TextBox11, LookAt:=xlWhole)
If Not bul Is Nothing Then

.Cells(bul.Row, "a").Value = TextBox11
.Cells(bul.Row, "b").Value = TextBox1
.Cells(bul.Row, "c").Value = TextBox2
.Cells(bul.Row, "d").Value = TextBox3
.Cells(bul.Row, "e").Value = TextBox4
.Cells(bul.Row, "f").Value = ComboBox1
.Cells(bul.Row, "g").Value = TextBox5
.Cells(bul.Row, "h").Value = ComboBox2
.Cells(bul.Row, "i").Value = TextBox6
.Cells(bul.Row, "j").Value = TextBox7
.Cells(bul.Row, "k").Value = ComboBox3
.Cells(bul.Row, "l").Value = TextBox8
.Cells(bul.Row, "m").Value = TextBox9
.Cells(bul.Row, "n").Value = TextBox10
.Cells(bul.Row, "o").Value = ComboBox4

Else
MsgBox "Değiştirmek istediğiniz veriyi önce BUL tuşu ile seçiniz !", vbExclamation
End If
End With

UserForm_Initialize
MsgBox "Verileriniz düzeltildi. Form boşaltılıyor."
For i = 8 To 16
Me.Controls("textbox" & i) = ""
Next i



ThisWorkbook.Save
Application.DisplayAlerts = True


End Sub




Private Sub CommandButton4_Click()

Sheets("TABLO").Select
If ActiveCell.Row < 2 Then
MsgBox "İlk önce BUL ile silmek istediğiniz veriyi bulmalısınız!", vbCritical
Exit Sub
End If

Onay = MsgBox("Seçtiğiniz kayıt silinecektir! Onaylıyor musunuz?", vbExclamation + vbYesNo)
If Onay = vbNo Then Exit Sub
ActiveCell.EntireRow.Delete
'Range("b2:b" & Rows.Count).ClearContents
For sira = 2 To Cells(65536, "B").End(xlUp).Row
ActiveSheet.Cells(sira, "A") = sira - 1
Next
MsgBox "Seçtiğiniz kayıt silinmiştir. Form yeni bir işlem için boşaltılıyor ", vbInformation
For i = 8 To 16
Me.Controls("textbox" & i) = ""
Next i

UserForm_Initialize
ThisWorkbook.Save


End Sub

Private Sub CommandButton6_Click()

Application.DisplayAlerts = False

MsgBox " Süzülen veri baskıya gönderilecek. Lütfen makinede kağıt olduğundan emin olun"
Sheets("rapor").PrintOut
MsgBox "Süzülen veri baskıya gönderildi"
Sheets("RAPOR").Range("A2:O" & Rows.Count).Clear
Sheets("tablo").Select
ThisWorkbook.Save

Application.DisplayAlerts = True

End Sub


Private Sub CommandButton3_Click()

Application.DisplayAlerts = False


MsgBox "Verilerinize değiştirilmeyecek, sadece form boşaltılıyor."
For i = 8 To 16
Me.Controls("textbox" & i) = ""
Next i


UserForm_Initialize
MsgBox " Sadece form boşaltıldı"
Application.DisplayAlerts = True


End Sub




Private Sub CommandButton5_Click()

Sheets("tablo").Select
Set bul = Range("a:a").Find(TextBox11)
If Not bul Is Nothing Then
bul.Offset(0, 1).Select
TextBox11 = bul.Value
TextBox1 = bul.Offset(0, 1).Value
TextBox2 = bul.Offset(0, 2).Value
TextBox3 = bul.Offset(0, 3).Value
TextBox4 = bul.Offset(0, 4).Value
ComboBox1 = bul.Offset(0, 5).Value
TextBox5 = bul.Offset(0, 6).Value
ComboBox2 = bul.Offset(0, 7).Value
TextBox6 = bul.Offset(0, 8).Value
TextBox7 = bul.Offset(0, 9).Value
ComboBox3 = bul.Offset(0, 10).Value
TextBox8 = bul.Offset(0, 11).Value
TextBox9 = bul.Offset(0, 12).Value
TextBox10 = bul.Offset(0, 13).Value
ComboBox4 = bul.Offset(0, 14).Value











Else
MsgBox "Aranan veri bulunamadı!", vbCritical
End If

ThisWorkbook.Save


End Sub



Private Sub TextBox12_Change() 'ADI SOYADI / UNVANINA GÖRE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox12 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("B1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=2, Criteria1:=TextBox12.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=2
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=2
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True


End Sub


Private Sub TextBox13_Change() ' CEZA TARİHİNE GORE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox13 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("C1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=3, Criteria1:=TextBox13.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=3
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=3
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True



End Sub



Private Sub TextBox14_Change() ' SERİ NOYA GORE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox14 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("E1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=5, Criteria1:=TextBox14.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=5
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=5
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True



End Sub



Private Sub TextBox15_Change() ' DOSYA NOYA GÖRE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox15 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("L1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=6, Criteria1:=TextBox15.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=6
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=6
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True



End Sub


Private Sub TextBox16_Change() ' ENC. K. TARİHİNE GÖRE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox16 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("M1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=7, Criteria1:=TextBox16.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=7
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=7
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True



End Sub


Private Sub TextBox17_Change() 'ENC. K. SAYISINA GORE

Dim S1 As Worksheet, S2 As Worksheet, Satir As Long

Application.ScreenUpdating = False

Set S1 = Sheets("TABLO")
Set S2 = Sheets("RAPOR")

If TextBox17 <> "" Then
ListBox2.RowSource = ""
S2.Cells.Delete
S1.Range("N1").AutoFilter
S1.Range("A1:O" & S1.Rows.Count).AutoFilter Field:=4, Criteria1:=TextBox17.Text & "*"
S1.Range("A1").CurrentRegion.Copy S2.Range("A1")
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=4
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "RAPOR!A2:O" & Satir
Else
S1.Range("A2:O" & S1.Rows.Count).AutoFilter Field:=4
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row
ListBox2.RowSource = "TABLO!A2:O" & Satir
End If
Columns("A:O").EntireColumn.AutoFit
Application.ScreenUpdating = True


End Sub



Private Sub UserForm_Initialize()


Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
'MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next


ListBox1.ColumnHeads = True
ListBox1.ColumnCount = 11
ListBox1.ColumnWidths = "35;90;80;85;75;75;70;60;90;80;60"
' listbox1.RowSource = "sayfa1!a5:t" & Sheets("sayfa1").[b65536].End(xlUp).Row + 1
ListBox1.RowSource = "TABLO!a2:O" & Worksheets("TABLO").Cells(Rows.Count, "b").End(2).Row
TextBox11 = Worksheets("TABLO").Cells(Rows.Count, "B").End(3).Row

Label5.Caption = Sheets("TABLO").Range("a1")
Label1.Caption = Sheets("TABLO").Range("b1")
Label2.Caption = Sheets("TABLO").Range("c1")
Label3.Caption = Sheets("TABLO").Range("d1")
Label4.Caption = Sheets("TABLO").Range("e1")
Label5.Caption = Sheets("TABLO").Range("f1")
Label6.Caption = Sheets("TABLO").Range("g1")
Label7.Caption = Sheets("TABLO").Range("h1")
Label8.Caption = Sheets("TABLO").Range("i1")
Label9.Caption = Sheets("TABLO").Range("j1")
Label10.Caption = Sheets("TABLO").Range("k1")
Label11.Caption = Sheets("TABLO").Range("l1")
Label12.Caption = Sheets("TABLO").Range("m1")
Label13.Caption = Sheets("TABLO").Range("n1")
Label14.Caption = Sheets("TABLO").Range("o1")


ListBox2.ColumnHeads = True
ListBox2.ColumnCount = 11
ListBox2.ColumnWidths = "35;90;80;85;75;75;70;60;90;80;60"
' listbox1.RowSource = "sayfa1!a5:t" & Sheets("sayfa1").[b65536].End(xlUp).Row + 1
ListBox2.RowSource = "TABLO!a2:O" & Worksheets("TABLO").Cells(Rows.Count, "b").End(3).Row
TextBox1 = Worksheets("TABLO").Cells(Rows.Count, "B").End(3).Row



End Sub

 

[YUSUF44]

Muhtemelen ben yardımcı olamam. Ancak yardımcı olacak arkadaşlara hangi kodda nasıl bir düzeltme yapılacağını açıklasaydınız iyi olurdu.

 

[PLİNT]

Merhaba
Ek dosyayı deneyin eksiklik varsa düzeltmeye çalışırız.
https://www.dosyaupload.com/hPhD