Soru Yazdırma öncesi onay

[sirkülasyon]

 Dim Yazıcı As String
    Yazıcı = Application.Dialogs(xlDialogPrinterSetup).Show
    If Yazıcı = False Then Exit Sub
    Sheets("ÇİZELGE").PrintOut From:=1, To:=1, Copies:=1, Collate:=True

yukarıda yer alan koda
yazdırmak ister misiniz? EVET ise 3 sayfa HAYIR ise yazdırmayı iptal etmesi şartını nasıl ekleyebilirim?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Onayli_Yazdir()
    Dim Yazici As String, Onay As Byte
    Yazici = Application.Dialogs(xlDialogPrinterSetup).Show
    If Yazici = False Then Exit Sub
    Onay = MsgBox("Yazdırmak istiyor musunuz?", vbExclamation + vbYesNo + vbDefaultButton2)
    If Onay = vbNo Then Exit Sub
    Sheets("ÇİZELGE").PrintOut From:=1, To:=1, Copies:=3, Collate:=True
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

 

[sirkülasyon]

Korhan abi ellerine sağlık teşekkür ederim.
Rica etsem ekli dosyada Veri Sayfasını Aç (Şifresi 1) butonu ile gizli sekme açıldığında sayfada veri girilip de silindiği zaman sayfayı kilitliyor. Bakabilmeniz mümkün mü?

 

[Korhan Ayhan]

Kodu sonsuz döngüye sokmuşsunuz. Bu sebeple kilitleniyor.

Bu sayfada ne kontrolü yapıyorsunuz?

 

[sirkülasyon]

T.C kimlik kontrolü Korhan abi

 

[Korhan Ayhan]

Tamam onu anladım ama kontrol ederken ne yaptırmak istiyorsunuz?

Ayrıca sıfırla başlayan TC numaralarını nasıl giriyorsunuz. Alan "Genel" olarak tanımlı görünüyor. Bence "Metin" yapmalısınız.

Aşağıdaki kodu deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E5:E31")) Is Nothing Then Exit Sub
    
    Target.ClearComments
    
    If Target.Value = "" Then Exit Sub
    
    If TCKimlikOnYazimKontrol(Target.Value) = False Then
        With Target
            .AddComment "Hatalı !"
            .Comment.Visible = True
            .Comment.Shape.TextFrame.AutoSize = True
        End With
    Else
        If Len(Target.Value) = 9 And IsNumeric(Target.Value) Then
            Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
        End If
    End If
End Sub

 

[sirkülasyon]

Korhan Abi
Yardımınızı esirgemediğiniz için teşekkür eder, saygılarımı sunarım. Var olasın

 

[Korhan Ayhan]

Küçük bir düzenleme yaptım. Son halini kullanınız.

 

[sirkülasyon]

Korhan Abi Teşekkür ederim.

 

[veyselemre]

TCKimlikSon2CDKodEkle de
If Len(tcid) <> 9 And Not IsNumeric(tcid) Then
kısmı hatalı olmuş aşağıdaki gibi düzeltin.

Function TCKimlikSon2CDKodEkle(tcid)
    Dim d(1 To 9) As Integer
    If Len(tcid) <> 9 Or Not IsNumeric(tcid) Then
        TCKimlikSon2CDKodEkle = "hata"
    Else
        For n = 1 To 9
            d(n) = Mid(tcid, n, 1)
        Next
        top1 = d(1) + d(3) + d(5) + d(7) + d(9)
        top2 = d(2) + d(4) + d(6) + d(8)

        cd1 = (10 - (((3 * top1) + top2) Mod 10)) Mod 10
        cd2 = (10 - (((3 * (top2 + cd1)) + top1) Mod 10)) Mod 10
        TCKimlikSon2CDKodEkle = tcid & cd1 & cd2
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E5:E31")) Is Nothing Then Exit Sub

    Target.ClearComments

    If Target.Value = "" Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Len(Target.Value) = 9 Then
            Target.Value = TCKimlikSon2CDKodEkle(Target.Value)
        ElseIf Len(Target.Value) = 11 And TCKimlikOnYazimKontrol(Target.Value) Then
        Else
            With Target
                .AddComment "Hatalı !"
                .Comment.Visible = True
                .Comment.Shape.TextFrame.AutoSize = True
            End With
        End If
    Else
        Target.Value = "TCKNo Giriniz."
    End If
End Sub

 

[sirkülasyon]

Veysel Abi Düzelttim. Teşekkür ederim. Sağ Olasın