Print To PRN In Excel With More Than 240 Characters Per Row

I had a situation at work where a coworker needed to export a spreadsheet to a fixed width pnr file.  The resulting file was truncated at 240 characters, which I believe is part of the pnr standard (I haven't actually looked that up or anything).  So I wrote a script to export a spreadsheet to a fixed width .pnr file regardless of the number of columns.

To make it easier to code, I prompt for the number of columns and rows and it uses a common dialog control to get the destination file path.  If you don't have the common dialog control you'll get an ActiveX error.  The whole section prompting for file location can be replaced with an InputBox function, but that is neither here nor there.

Also, for your Excelling pleasure, I added a PadRight function since I couldn't seem to find one in Excel 2003. 

Just add the following script to your worksheet (Alt+F11 and double-click Sheet1 usually, paste and click the "play" button)

Enjoy:

Public Function PrintPRN() As String
'Because PRN files have a 240 character line width limitation,
'the following script will print out the current worksheet as
'a fixed width text file based on the column widths of the
'spreadsheet.
    Dim DestinationFile As String
    Dim CDialog As Object
   
    Set CDialog = CreateObject("MSComDlg.CommonDialog")
   
    With CDialog
        .DialogTitle = "Select location to save file"
        .DefaultExt = ".prn"
        .Filter = "Fixed width (*.prn)|*.prn"
        .ShowSave
        DestinationFile = .Filename
    End With
   
    'Verify a file was entered
    If Len(DestinationFile) = 0 Then Exit Function
   
    Dim FileNum As Integer
    Dim Line As String
    Dim RowIndex As Long
    Dim ColIndex As Long
   
    Dim RowCount As Long
    Dim ColCount As Long
   
    ColCount = CLng(InputBox("Enter the number of COLUMNS:"))
    RowCount = CLng(InputBox("Enter the number of ROWS:"))
   

    FileNum = FreeFile
    Open DestinationFile For Append As #FileNum
   
        For RowIndex = 1 To RowCount
            'Build new line
            Line = ""
            For ColIndex = 1 To ColCount
                Line = Line & PadRight(Cells(RowIndex, ColIndex), Columns(ColIndex).ColumnWidth)
            Next ColIndex
           
            'Write the line to the text file
            Print #FileNum, Line
        Next RowIndex
    Close #FileNum
   
    Set CDialog = Nothing
   
    MsgBox "Done!"
 
End Function

Private Function PadRight(ByVal Value As String, ByVal Width As Long)

As String
Dim PaddingNum As Integer

    PaddingNum = Width - Len(Value)
   
    If PaddingNum > 0 Then
        Value = Value & Space(PaddingNum)
    End If
   
    PadRight = Value
End Function