I'd still add one of those suggested checks to make sure that the array of
columnwidths has enough values for all the columns that may be used.

Little Penny wrote:

Adding the
Option Explicit and
Option Base 1 back to the code worked.

Thanks to everyone

On Mon, 10 Sep 2007 21:34:42 -0500, Dave Peterson
wrote:

I think you deleted a check from the original post:
http://google.com/groups?threadm=015...0a% 40phx.gbl

I'd add this portion back:

If Rng.Columns.Count UBound(myColWidths) - LBound(myColWidths) + 1 Then
MsgBox "Please contact Brenda at x#### " & vbLf & _
"Tell her you have more columns than she thought were necessary!"
Exit Sub
End If

But change Brenda to your name!

And I'd add those two compiler directives back, too:

Option Explicit
Option Base 1

(Like OssieMac said.)




Little Penny wrote:

This macro exports my spread sheet to a fixed with prn file. It works
great if my array is

myColWidths = Array(69, 13, 11, 48, 18, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 26, 127, 64, 71, 1)

But if I change it to:

myColWidths = Array(69, 13, 11, 19, 29, 18, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 26, 127, 135, 1)

To accommodate different column widths I get a Run-time error '9':
Subscript out of range and the code stops he

cellStr = Left(Rng(iRow, iCol).Text & _
Space(myColWidths(iCol)), myColWidths(iCol))

I can’t figure out why. Any help would be great appreciated. My entire
code is as follows:

Sub SaveAsFixedWidthSummitLeh()

Dim Rng As Range
Dim myColWidths As Variant
Dim iCol As Long
Dim iRow As Long
Dim myFileName As Variant
Dim myFileNum
Dim resp As Long
Dim myStr As String
Dim cellStr As String

myColWidths = Array(69, 13, 11, 19, 29, 18, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 26, 127, 135, 1)


With ActiveSheet
Set Rng = .UsedRange 'try to reset last used cell.
Set Rng = Range("a1", .Cells.SpecialCells(xlCellTypeLastCell))
End With


Do
myFileName = Application.GetSaveAsFilename( _
fileFilter:="Prn Files, *.Prn", _
InitialFileName:="SavedFile.Prn", Title:="Save
A Range")

If myFileName = False Then End

If Dir(CStr(myFileName)) < "" Then
resp = MsgBox(Prompt:="Overwrite the existing file?", _
Buttons:=vbCritical + vbYesNoCancel)
Select Case resp
Case Is = vbCancel
MsgBox "Try Later"
Exit Sub
Case Is = vbYes: Exit Do
End Select
Else
Exit Do
End If
Loop

myFileNum = FreeFile()
Close #myFileNum
Open myFileName For Output As #myFileNum

For iRow = 1 To Rng.Rows.Count
If (iRow \ 50) * 50 = iRow Then
Application.StatusBar = "Processing row: " _
& iRow & " at: " & Now
End If
myStr = ""
For iCol = 1 To Rng.Columns.Count
If Application.IsNumber(Rng(iRow, iCol).Value) Then
'right justify the contents
cellStr = Right(Space(myColWidths(iCol)) & _
Rng(iRow, iCol).Text, myColWidths(iCol))
Else
'text is justified to the left??
cellStr = Left(Rng(iRow, iCol).Text & _
Space(myColWidths(iCol)),
myColWidths(iCol))
End If
myStr = myStr & cellStr
Next iCol
Print #myFileNum, myStr
Next iRow

Close #myFileNum
MsgBox "Done at: " & Now

With Application
.StatusBar = False
End With

End Sub

Thanks

--

Dave Peterson