?
Solved

Printing

Posted on 2003-02-24
4
Medium Priority
?
195 Views
Last Modified: 2013-12-25
I have one VB application that perfectly print the text file. First, it will get the list of the text file and move it to another list. When the print button is pressed, the text file in the new list is printed.

There is another combo box to choose which month the users are willing to print. If the users choose January then all January data from the text file only are printed and so on.

The problem :
When I choose January, the November data is also be printed. The second one, when I choose February, the December is also be printed. How to do it? I have really no idea.

Here is the code for the print button.
Private Sub cmdPrint_Click()
   
    Dim PrintStatus, Printable, allMonth, Found As Boolean
    Dim tString, Header1, Header2 As String
    Dim sIndexNum, pMonth, pYear, pProject As String
    Dim word, word1, file As String
    Dim RefNum, sDate, Subject, TempSubject, SendTo, Author As String
    Dim ColWidth1, ColWidth2, ColWidth3, ColWidth4, ColWidth5 As Integer
    Dim I, C, round, sPointer, TempPointer, pNum As Integer
   
    If cmbMonth.text = "" Then
        Beep
        request = MsgBox("Please select a Month to print", vbExclamation, "Error Message")
        GoTo MainError
    End If
   
    If lslSelected.List(0) = "" Then
        Beep
        request = MsgBox("No Project is selected for printing, please select again", vbExclamation, "Error Message")
        GoTo MainError
    End If
   
    If txtYear.text = "" Then
        Beep
        request = MsgBox("Please keyin the year to print", vbExclamation, "Error Message")
        GoTo MainError
    End If
   
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    ' copy selected data files to temp folder for printing
    If Dir("c:\windows\temp\") = "" Then
        request = MsgBox("Error, temp folder c:\windows\temp does not exist, please create.", vbCritical, "Message")
        GoTo MainError
    Else
        For Index = 0 To lslSelected.ListCount
       
            If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
                sIndexNum = "SINRefNum"
            Else
                If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
                    sIndexNum = Replace(lslSelected.List(Index), "/", "")
                Else
                    sIndexNum = lslSelected.List(Index) & "*"
                End If
            End If
       
            If Right(sIndexNum, 1) = "*" Then
                file = Dir(App.Path + "\data\" + sIndexNum + ".txt")
                Do While file <> ""
                    FileCopy (App.Path + "\data\" + file), ("c:\windows\temp\" + Left(file, Len(file) - 4) + ".pnp")
                    file = Dir
                Loop
            Else
                FileCopy (App.Path + "\data\" + sIndexNum + ".txt"), ("c:\windows\temp\" + sIndexNum + ".pnp")
            End If
        Next Index
    End If
   
    ' Set Column Width of print out
    ColWidth1 = 20
    ColWidth2 = 13
    ColWidth3 = 85
    ColWidth4 = 35
    ColWidth5 = 25
   
    allMonth = False
    pMonth = Str(cmbMonth.ListIndex)
    If pMonth = 0 Then
        allMonth = True
    End If
    pYear = txtYear.text
    pMonth = pMonth + "/" + pYear
    pMonth = Trim(pMonth)
   
    Index = 0
   
    ' process files from the selected list until complete
    Do While lslSelected.List(Index) <> ""
       
        ' Set Printer Parameters
        Printer.FontName = "Courier New"
        Printer.Orientation = 2
   
        ' format filename from selected list for process
        If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
            pProject = "SIN Projects"
            sIndexNum = "SINRefNum"
        Else
            If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
                sPointer = InStr(1, lslSelected.List(Index), "/", vbTextCompare)
                pProject = Left(lslSelected.List(Index), sPointer + 1) + "." + Right(lslSelected.List(Index), (Len(lslSelected.List(Index)) - sPointer - 1))
                sIndexNum = Replace(lslSelected.List(Index), "/", "")
            Else
                sIndexNum = lslSelected.List(Index)
            End If
        End If
       
        ' open txt file for input
        Open "c:\windows\temp\" + sIndexNum + ".pnp" For Input As #1
        Line Input #1, tString
           
        ' set starting page number
        pNum = 1
       
        ' set headers
        If allMonth = False Then
            Header1 = "Reference Number List of JRP Project " & pProject & " for the month of " & cmbMonth.text & " " & txtYear.text
        Else
            Header1 = "Reference Number List of JRP Project " & pProject & " for the year " & txtYear.text
        End If
        Header2 = "Ref Number      Date       Subject                                                             Send To                     Author"
       
        ' print header
        Printer.FontSize = 14
        Printer.FontBold = True
        Printer.Print
        Printer.Print
        Printer.Print Header1
        Printer.Print
        Printer.FontSize = 10
        Printer.FontBold = True
        Printer.Print Header2
        Printer.Print
        Printer.FontSize = 8
        Printer.FontBold = False
       
        ' readin, process and print data
        Do While (EOF(1) <> True) And (tString <> "")
               
            ' initialize print string
            word = ""
            word1 = ""
           
            Printable = False
           
            sPointer = 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
                For C = 1 To (ColWidth1 - Len(RefNum))
                    RefNum = RefNum + " "
                Next C
                word = word + RefNum
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                ' check whether record belong to the selected month
                ' if yes set 'printable' to 'true'
                If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
                    Printable = True
                End If
               
                For C = 1 To (ColWidth2 - Len(sDate))
                    sDate = sDate + " "
                Next C
                word = word + sDate
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                ' if subject field cannot fit into the column width
                If Len(Subject) > ColWidth3 Then
                    TempSubject = Left(Subject, ColWidth3)
                    TempPointer = 0
                    I = ColWidth3
                    Found = False
                    Do While (I <> 0) And (Found = False)
                        If Mid(TempSubject, I, 1) = " " Then
                            TempPointer = I
                            Found = True
                        Else
                            I = I - 1
                        End If
                    Loop
                    word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
                    Subject = Left(Subject, TempPointer - 1)
                End If
               
                For C = 1 To (ColWidth3 - Len(Subject))
                    Subject = Subject + " "
                Next C
                word = word + Subject
               
                If word1 <> "" Then
                    For I = 1 To ColWidth1 + ColWidth2
                        word1 = " " + word1
                    Next I
                    For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
                        word1 = word1 + " "
                    Next I
                End If
               
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                ' if sendto field cannot fit into the column width
                If Len(SendTo) > ColWidth4 Then
                    TempSendTo = Left(SendTo, ColWidth3)
                    TempPointer = 0
                    I = ColWidth4
                    Found = False
                    Do While (I <> 0) And (Found = False)
                        If Mid(TempSendTo, I, 1) = " " Then
                            TempPointer = I
                            Found = True
                        Else
                            I = I - 1
                        End If
                    Loop
                    word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
                    SendTo = Left(SendTo, TempPointer - 1)
                End If
               
                For C = 1 To (ColWidth4 - Len(SendTo))
                    SendTo = SendTo + " "
                Next C
                word = word + SendTo
               
                If word1 <> "" Then
                    If Left(word1, 1) <> " " Then
                        For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
                            word1 = " " + word1
                        Next I
                    End If
                End If
           
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
                For C = 1 To (ColWidth5 - Len(Author))
                    Author = Author + " "
                Next C
                word = word + Author
            End If
           
            ' Print the Word if printable
            If Printable Then
                               
                ' Start a new page if needed.
                If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
                    Printer.FontSize = 10
                    Printer.FontBold = True
                    Printer.Print "Page " & pNum
                    Printer.FontSize = 8
                    Printer.FontBold = False
                    Printer.NewPage
                    pNum = pNum + 1
                    ' print header
                    Printer.FontSize = 14
                    Printer.FontBold = True
                    Printer.Print
                    Printer.Print
                    Printer.Print Header1
                    Printer.Print
                    Printer.FontSize = 10
                    Printer.FontBold = True
                    Printer.Print Header2
                    Printer.Print
                    Printer.FontSize = 8
                    Printer.FontBold = False
                End If
               
                Printer.Print word
                If word1 <> "" Then
                    Printer.Print word1
                End If
                Printer.Print
                           
            End If
           
            Line Input #1, tString
           
        Loop
       
        If tString <> "" Then
           
            ' initialize print string
            word = ""
            word1 = ""
           
            Printable = False
           
            sPointer = 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
                For C = 1 To (ColWidth1 - Len(RefNum))
                    RefNum = RefNum + " "
                Next C
                word = word + RefNum
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
                    Printable = True
                End If
               
                For C = 1 To (ColWidth2 - Len(sDate))
                    sDate = sDate + " "
                Next C
                word = word + sDate
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                ' if subject field cannot fit into the column width
                If Len(Subject) > ColWidth3 Then
                    TempSubject = Left(Subject, ColWidth3)
                    TempPointer = 0
                    I = ColWidth3
                    Found = False
                    Do While (I <> 0) And (Found = False)
                        If Mid(TempSubject, I, 1) = " " Then
                            TempPointer = I
                            Found = True
                        Else
                            I = I - 1
                        End If
                    Loop
                    word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
                    Subject = Left(Subject, TempPointer - 1)
                End If
               
                For C = 1 To (ColWidth3 - Len(Subject))
                    Subject = Subject + " "
                Next C
                word = word + Subject
               
                If word1 <> "" Then
                    For I = 1 To ColWidth1 + ColWidth2
                        word1 = " " + word1
                    Next I
                    For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
                        word1 = word1 + " "
                    Next I
                End If
               
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
               
                ' if sendto field cannot fit into the column width
                If Len(SendTo) > ColWidth4 Then
                    TempSendTo = Left(SendTo, ColWidth3)
                    TempPointer = 0
                    I = ColWidth4
                    Found = False
                    Do While (I <> 0) And (Found = False)
                        If Mid(TempSendTo, I, 1) = " " Then
                            TempPointer = I
                            Found = True
                        Else
                            I = I - 1
                        End If
                    Loop
                    word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
                    SendTo = Left(SendTo, TempPointer - 1)
                End If
               
                For C = 1 To (ColWidth4 - Len(SendTo))
                    SendTo = SendTo + " "
                Next C
                word = word + SendTo
               
                If word1 <> "" Then
                    If Left(word1, 1) <> " " Then
                        For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
                            word1 = " " + word1
                        Next I
                    End If
                End If
           
            End If
           
            sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
            If sPointer >= Len(tString) Then
                request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
                GoTo SubError
            Else
                Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
                For C = 1 To (ColWidth5 - Len(Author))
                    Author = Author + " "
                Next C
                word = word + Author
            End If
           
            ' Print the Word if printable
            If Printable Then
                               
                ' Start a new page if needed.
                If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
                    Printer.FontSize = 10
                    Printer.FontBold = True
                    Printer.Print "Page " & pNum
                    Printer.FontSize = 8
                    Printer.FontBold = False
                    Printer.NewPage
                    pNum = pNum + 1
                    ' print header
                    Printer.FontSize = 14
                    Printer.FontBold = True
                    Printer.Print
                    Printer.Print
                    Printer.Print Header1
                    Printer.Print
                    Printer.FontSize = 10
                    Printer.FontBold = True
                    Printer.Print Header2
                    Printer.Print
                    Printer.FontSize = 8
                    Printer.FontBold = False
                End If
               
                Printer.Print word
                If word1 <> "" Then
                    Printer.Print word1
                End If
                Printer.Print
                           
            End If
           
        End If
       
        Printer.CurrentY = 10978
        Printer.CurrentX = 0
        Printer.FontSize = 10
        Printer.FontBold = True
        Printer.Print "Page " & pNum
        Printer.FontSize = 8
        Printer.FontBold = False
        Printer.EndDoc
       
SubError:
        Close #1
                   
        Set a = fso.GetFile("c:\windows\temp\" + sIndexNum + ".pnp")
        a.Delete
        lslSelected.RemoveItem (Index)
    Loop
   
    request = MsgBox("Finish Printing", vbOKOnly, "Message")
   
     
MainError:

End Sub
0
Comment
Question by:suprapto45
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 2

Expert Comment

by:Jacamar
ID: 8018097
This is an awful lot of code for such a small problem.  If all the other months work, the problem will be when the user picks either january or february.  Does the problem occur if December or November are chosen?  

It makes some sense that this error occurs because the program is for somereason recognizing month 1 and 11 as being equal and 2 and 12.  You should redefine the way your program identifies the item from the combobox.  How are you doing it now?  Do you need to know another way?
0
 
LVL 16

Author Comment

by:suprapto45
ID: 8021994
Dear Jacamar, thanks for your reply. Yes can you show me the solution for it?

Thnak you
0
 
LVL 5

Accepted Solution

by:
Flembosa earned 120 total points
ID: 8132085
When you are checking months format the month to a 2 digit month.

'Your code without change
'-------------------

' check whether record belong to the selected month
' if yes set 'printable' to 'true'
  If InStr(1, sDate, pMonth, vbTextCompare) _
    Or (allMonth = True) Then
     
      Printable = True
  End If

'-------------------
'Your code with change
'-------------------

' check whether record belong to the selected month
' if yes set 'printable' to 'true'
  If Format(sDate, "mm/yyyy") = format(pMonth, "mm/yyyy") _
    Or (allMonth = True) Then
     
      Printable = True
  End If
'-------------------

See if that works.

Flembosa
0
 
LVL 6

Expert Comment

by:GPrentice00
ID: 9116419
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

 -->Accept Flembosa's comment as Answer

Please leave any comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER

GPrentice00
Cleanup Volunteer
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question