Soru Yazdırma öncesi onay

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,471
Excel Vers. ve Dili
2021 LTSC TR
Kod:
 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

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
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

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,471
Excel Vers. ve Dili
2021 LTSC TR
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ü?
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu sonsuz döngüye sokmuşsunuz. Bu sebeple kilitleniyor.

Bu sayfada ne kontrolü yapıyorsunuz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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.

C++:
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

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,471
Excel Vers. ve Dili
2021 LTSC TR
Korhan Abi
Yardımınızı esirgemediğiniz için teşekkür eder, saygılarımı sunarım. Var olasın
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Küçük bir düzenleme yaptım. Son halini kullanınız.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,553
Excel Vers. ve Dili
Pro Plus 2021
TCKimlikSon2CDKodEkle de
If Len(tcid) <> 9 And Not IsNumeric(tcid) Then
kısmı hatalı olmuş aşağıdaki gibi düzeltin.

Kod:
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

Kod:
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

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,471
Excel Vers. ve Dili
2021 LTSC TR
Veysel Abi Düzelttim. Teşekkür ederim. Sağ Olasın
 
Üst