• DİKKAT

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

Denetim Çalışma programı

power468

power468

Katılım
23 Aralık 2017
Mesajlar
48
Excel Vers. ve Dili
2016
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
 

Ekli dosyalar

Son düzenleme:
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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst