Merhaba arkadaşlar ekteki kodlara şifre kaldırma ve koyma giriyorum. Kodlar çalışıyor gibi gözüküyor ama işlem yapmıyor. Konu hakkında yardımcı olabilir misiniz?
Public LoginInstance As Integer
Function G04_K() As Boolean
Dim frm As Worksheet
Set frm = ThisWorkbook.Sheets("G04")
G04_K = True
With frm
.Range("BJ12").Interior.Color = xlNone
.Range("BJ13").Interior.Color = xlNone
End With
'Tarih Doğrulaması
If Trim(frm.Range("BJ12").Value) = "" Then
MsgBox "Tarih alanı boş. Lütfen tarih alanını girin.", vbOKOnly + vbInformation, "Tarih"
frm.Range("BJ12").Select
frm.Range("BJ12").Interior.Color = vbYellow
G04_K = False
Exit Function
End If
'Gelir Kalemi Doğrulama
If Trim(frm.Range("BJ13").Value) = "" Then
MsgBox "Lütfen açılır menüden Gelir Kalemi'ni seçin.", vbOKOnly + vbInformation, "Gelir Kalemi"
frm.Range("BJ13").Select
frm.Range("BJ13").Interior.Color = vbYellow
G04_K = False
Exit Function
End If
End Function
Sub G04_0()
Application.ScreenUpdating = False
Application.EnableEvents = False 'İşlemi hızlı yapması için yazıldı.
Dim msg As VbMsgBoxResult
msg = MsgBox("Verileri kaydetmek istiyor musunuz?", vbYesNo + vbQuestion, " Onayla")
If msg = vbNo Then Exit Sub
If G04_K = True Then
Call G04_01
End If
Application.ScreenUpdating = True 'İşlemi hızlı yapması için yazıldı.
Application.EnableEvents = True
End Sub
Sub G04_01() 'TOPLU BORÇLANDIRMA KAYDI
If Range("BM10").Value = 1 Then
Call G04_02
Sheets("G04").Range("BJ12:CA12,BJ13:CA13,BJ16:CA17").ClearContents
Sheets("G04").Range("CZ12").Value = ""
Sheets("G04").Range("DA12").Value = ""
MsgBox "Toplu Borçlandırma kaydı tamamlanmıştır.", vbInformation, "Kayıt"
Sheets("G04").Select
Range("BJ12").Select
ElseIf Range("BM10").Value = 2 Then
MsgBox "Bu toplu borçlandırma kaydı daha önce kaydedilmiş.", vbCritical, "Kayıt"
Sheets("G04").Select
Range("BJ12").Select
End If
End Sub
Sub G04_02() 'DATA
Range("CZ12").Value = Format([Now()], "DD-MM-YYYY HH:MM:SS") 'Gönderilme Tarihi
Range("DA12").Value = Application.UserName 'Tarafından gönderilmiştir
Range("CG12A21").Copy 'Veriler kopyalanıyor.
Sheets("Data").Select
Range("A1").Select
Dim SonSat As Long
SonSat = Cells(Rows.Count, "A").End(3).Row + 1
Range("A" & SonSat).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Veriler yapıştırılıyor.
Range("A1").Select
Application.CutCopyMode = False
End Sub
Public LoginInstance As Integer
Function G04_K() As Boolean
Dim frm As Worksheet
Set frm = ThisWorkbook.Sheets("G04")
G04_K = True
With frm
.Range("BJ12").Interior.Color = xlNone
.Range("BJ13").Interior.Color = xlNone
End With
'Tarih Doğrulaması
If Trim(frm.Range("BJ12").Value) = "" Then
MsgBox "Tarih alanı boş. Lütfen tarih alanını girin.", vbOKOnly + vbInformation, "Tarih"
frm.Range("BJ12").Select
frm.Range("BJ12").Interior.Color = vbYellow
G04_K = False
Exit Function
End If
'Gelir Kalemi Doğrulama
If Trim(frm.Range("BJ13").Value) = "" Then
MsgBox "Lütfen açılır menüden Gelir Kalemi'ni seçin.", vbOKOnly + vbInformation, "Gelir Kalemi"
frm.Range("BJ13").Select
frm.Range("BJ13").Interior.Color = vbYellow
G04_K = False
Exit Function
End If
End Function
Sub G04_0()
Application.ScreenUpdating = False
Application.EnableEvents = False 'İşlemi hızlı yapması için yazıldı.
Dim msg As VbMsgBoxResult
msg = MsgBox("Verileri kaydetmek istiyor musunuz?", vbYesNo + vbQuestion, " Onayla")
If msg = vbNo Then Exit Sub
If G04_K = True Then
Call G04_01
End If
Application.ScreenUpdating = True 'İşlemi hızlı yapması için yazıldı.
Application.EnableEvents = True
End Sub
Sub G04_01() 'TOPLU BORÇLANDIRMA KAYDI
If Range("BM10").Value = 1 Then
Call G04_02
Sheets("G04").Range("BJ12:CA12,BJ13:CA13,BJ16:CA17").ClearContents
Sheets("G04").Range("CZ12").Value = ""
Sheets("G04").Range("DA12").Value = ""
MsgBox "Toplu Borçlandırma kaydı tamamlanmıştır.", vbInformation, "Kayıt"
Sheets("G04").Select
Range("BJ12").Select
ElseIf Range("BM10").Value = 2 Then
MsgBox "Bu toplu borçlandırma kaydı daha önce kaydedilmiş.", vbCritical, "Kayıt"
Sheets("G04").Select
Range("BJ12").Select
End If
End Sub
Sub G04_02() 'DATA
Range("CZ12").Value = Format([Now()], "DD-MM-YYYY HH:MM:SS") 'Gönderilme Tarihi
Range("DA12").Value = Application.UserName 'Tarafından gönderilmiştir
Range("CG12A21").Copy 'Veriler kopyalanıyor.
Sheets("Data").Select
Range("A1").Select
Dim SonSat As Long
SonSat = Cells(Rows.Count, "A").End(3).Row + 1
Range("A" & SonSat).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Veriler yapıştırılıyor.
Range("A1").Select
Application.CutCopyMode = False
End Sub