• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

duplicate printing

S

srirajsa

Member
sir,

can i stop duplicate printing of worksheet i.e i want only one copy i f anyone want to take duplicate printing it should ask password


thankyou

sriniva
 
Hi, srirajsa!
In this case then maybe it'd better if you upload a sample file and then get it back yet fixed.
Please specify if the one time printing is for the whole workbook, for each worksheet or for certain worksheets only.
Regards!
 
sir

file is not uploading as it showing file is too large if you can give me your email id so that i can send, all the worksheet individually print each page one time only the reason is this is cash bill we dont want them to print duplicate

thanks

srinivas
 
Hi, srirajsa!

Give a look at this file:
https://dl.dropboxusercontent.com/u...ockdetails (for srirajsa at chandoo.org).xlsm

I added the worksheet PrintControl to hold the names of the worksheets being tracked (assumed that Billxxx) and the print count and last printed date. This list is refreshed at open time and and print time.

I set two passwords, one for printing yet printed worksheets (that BTW once it's asked once, if given then all people will know it, but it's not my problem) and another for resetting print counts, held in module modPrintControl in the constants:
gksPassword: esunachagar
gksPasswordReset: esunagranchagar

I suggest you to protect the VBA project using the same reset password (which it isn't done in the sample file) in order to avoid that curious eyes may read the passwords.

I also moved your SaveAndPrint macro to the print control module so as to keep all the stuff together; the rest of modules it's up to you to handle them as you require.

This is the code for the 2 involved modules:

Workbook class module:
Code: 
Option Explicit

Private Sub Workbook_Open()
    ' constants
    ' declarations
    ' start
    ' process
    UpdatePrintControlTable
    ' end
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    ' constants
    ' declarations
    Dim c As Range
    Dim I As Long, J As Long, A As String, D As Date
    Dim bOk As Boolean
    ' start
    Cancel = Not gbPrintEnabled
    If Cancel Then
        MsgBox "Selected print operation not allowed!" & vbCr & _
            "Print request cancelled.", _
            vbApplicationModal + vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    Set grngPC = Worksheets(gksWSPrintControl).Range(gksRngPrintControl)
    bOk = True
    ' process
    D = Now()
    With ActiveWindow
        For I = 1 To .SelectedSheets.Count
            With .SelectedSheets(I)
                If .Name Like gksWSPattern Then
                    Set c = grngPC.Columns(1).Find(.Name, grngPC.Cells(1, 1), xlValues, xlWhole)
                    c.Offset(0, 1).Value = CInt(c.Offset(0, 1).Value) + 1
                    c.Offset(0, 2).Value = D
                End If
            End With
        Next I
    End With
    ' end
    Set grngPC = Nothing
End Sub

Standard module modPrintControl:
Code: 
Option Explicit

' global constants
Global Const gksPassword = "esunachagar"
Global Const gksPasswordReset = "esunagranchagar"
Global Const gksWSPrintControl = "PrintControl"
Global Const gksRngPrintControl = "PrintControlTable"
Global Const gksWSPattern = "Bill*"

' global declarations
Global grngPC As Range
Global gbPrintEnabled As Boolean

Sub UpdatePrintControlTable()
    ' constants
    ' declarations
    Dim c As Range
    Dim I As Long, J As Long, A As String
    ' start
    Worksheets(gksWSPrintControl).Unprotect gksPassword
    gbPrintEnabled = False
    Set grngPC = Worksheets(gksWSPrintControl).Range(gksRngPrintControl)
    J = 0
    ' process
    For I = 1 To Worksheets.Count
        With Worksheets(I)
            A = .Name
            If A Like gksWSPattern Then
                Set c = grngPC.Columns(1).Find(A, grngPC.Cells(1, 1), xlValues, xlWhole)
                If c Is Nothing Then
                    J = J + 1
                    grngPC.Cells(grngPC.Rows.Count, 1).Offset(J, 0).Value = A
                End If
            End If
        End With
    Next I
    ' end
    Set grngPC = Nothing
    Worksheets(gksWSPrintControl).Protect gksPassword
    Beep
End Sub

Sub ControlPrintCount(pbCancel As Boolean)
    ' constants
    ' declarations
    Dim c As Range
    Dim I As Long, J As Long, A As String
    Dim bOk As Boolean
    ' start
    Set grngPC = Worksheets(gksWSPrintControl).Range(gksRngPrintControl)
    bOk = True
    ' process
    With ActiveWindow
        For I = 1 To .SelectedSheets.Count
            With .SelectedSheets(I)
                If .Name Like gksWSPattern Then
                    Set c = grngPC.Columns(1).Find(.Name, grngPC.Cells(1, 1), xlValues, xlWhole)
                    If CInt(c.Offset(0, 1).Value) <> 0 Then
                        bOk = False
                        Exit For
                    End If
                End If
            End With
        Next I
        If Not bOk Then
            Do
                J = MsgBox("Worksheet " & .SelectedSheets(I).Name & _
                    " yet printed on " & c.Offset(0, 2).Value & vbCr & vbCr & _
                    "You must enter the password for additional printing.", _
                    vbApplicationModal + vbQuestion + vbDefaultButton2 + vbOKCancel, _
                    "Additional printing dialog")
                If J = vbOK Then
                    A = InputBox("Enter the password:", "Additional printing confirmation")
                    bOk = (A = gksPassword)
                    If Not bOk Then
                        MsgBox "Wrong password!", _
                            vbApplicationModal + vbCritical + vbOKOnly, "Error"
                    End If
                End If
            Loop Until bOk Or J = vbCancel
        End If
    End With
    ' end
    Set grngPC = Nothing
    pbCancel = Not bOk
End Sub

Sub PrintAndSave()
    ' constants
    Const gkbTest = True
    ' declarations
    Dim bCancel As Boolean
    ' start
    UpdatePrintControlTable
    ' process
    ControlPrintCount bCancel
    If Not bCancel Then
        gbPrintEnabled = True
        Worksheets(gksWSPrintControl).Unprotect gksPassword
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=gkbTest
        Worksheets(gksWSPrintControl).Protect gksPassword
        gbPrintEnabled = False
        ActiveWorkbook.Save
    End If
    ' end
    Beep
End Sub

Sub ResetAllCounts()
    ' constants
    ' declarations
    Dim J As Integer, A As String, bOk As Boolean
    ' start
    Do
        J = MsgBox("You must enter the password to reset print counts.", _
            vbApplicationModal + vbInformation + vbDefaultButton2 + vbOKCancel, _
            "Reset print counts dialog")
        If J = vbOK Then
            A = InputBox("Enter the password:", "Reset print counts confirmation")
            bOk = (A = gksPasswordReset)
            If Not bOk Then
                MsgBox "Wrong password!", _
                    vbApplicationModal + vbCritical + vbOKOnly, "Error"
            End If
        End If
    Loop Until bOk Or J = vbCancel
    If Not bOk Then Exit Sub
    Worksheets(gksWSPrintControl).Unprotect gksPassword
    Set grngPC = Worksheets(gksWSPrintControl).Range(gksRngPrintControl)
    ' process
    With grngPC
        Range(.Cells(2, 2), .Cells(.Rows.Count, .Columns.Count)).ClearContents
    End With
    ' end
    Set grngPC = Nothing
    Worksheets(gksWSPrintControl).Protect gksPassword
    Beep
End Sub

Just advise if any issue.

Regards!

PS: A final humble advice: this workbook will become an unmanageable monster as time passes by and you sell & bill more, so if I were you I'd abandon immediately this terrifying method of storing and printing bills and buy/get/something a billing software.
 
thank you sir, its working

sir we do have an software called Oriel Retail Software, I have taken data from that and keeping as recent time s we are regularly having problem with our server. This excel sheet may helpful instead of writing manual bills.

Once again thanks so much

regards,

srinivas
 
Hi, srirajsa!
Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.
And regarding your software... if you have to rely on such type of workbooks to print bills I think you're in a big trouble.
Regards!
 
You must log in or register to reply here.
Back
Top