jeffrey.demulling at usbank.com
jeffrey.demulling at usbank.com
Tue Jun 15 10:28:01 CDT 2004
I am having some trouble with the code below. It works well for the first
file that is passed to it but the second time the code is called it errors
out on line 340. Anyone have any ideas on how to make this code work or
what my problem might be. Thanks for any help.
Sub FormatExcelFile(myfilename As String)
Dim x As Integer
Dim testvalue As String
Dim excelApp As Excel.Application
Dim excelFile As Excel.Workbook
'Open file
10 Set excelApp = CreateObject("Excel.Application")
20 excelApp.Visible = True
30 Set excelFile = excelApp.Workbooks.Open(myfilename)
40 With excelFile
'Setup the page
50 .Worksheets("AccountList").PageSetup.PrintTitleRows = "$1:$1"
60 .Worksheets("AccountList").PageSetup.PrintTitleColumns = ""
70 .Worksheets("AccountList").PageSetup.PrintArea = ""
80 .Worksheets("AccountList").PageSetup.LeftHeader = ""
90 .Worksheets("AccountList").PageSetup.CenterHeader = "&A"
100 .Worksheets("AccountList").PageSetup.RightHeader = ""
110 .Worksheets("AccountList").PageSetup.LeftFooter = ""
120 .Worksheets("AccountList").PageSetup.CenterFooter = "Page &P"
130 .Worksheets("AccountList").PageSetup.RightFooter = ""
140 .Worksheets("AccountList").PageSetup.LeftMargin =
excelApp.InchesToPoints(0.75)
150 .Worksheets("AccountList").PageSetup.RightMargin =
excelApp.InchesToPoints(0.75)
160 .Worksheets("AccountList").PageSetup.TopMargin =
excelApp.InchesToPoints(1)
170 .Worksheets("AccountList").PageSetup.BottomMargin =
excelApp.InchesToPoints(1)
180 .Worksheets("AccountList").PageSetup.HeaderMargin =
excelApp.InchesToPoints(0.5)
190 .Worksheets("AccountList").PageSetup.FooterMargin =
excelApp.InchesToPoints(0.5)
200 .Worksheets("AccountList").PageSetup.PrintHeadings = False
210 .Worksheets("AccountList").PageSetup.PrintGridlines = True
220 .Worksheets("AccountList").PageSetup.PrintComments =
xlPrintNoComments
230 .Worksheets("AccountList").PageSetup.CenterHorizontally = False
240 .Worksheets("AccountList").PageSetup.CenterVertically = False
250 .Worksheets("AccountList").PageSetup.Orientation = xlLandscape
260 .Worksheets("AccountList").PageSetup.Draft = False
270 .Worksheets("AccountList").PageSetup.PaperSize = xlPaperLetter
280 .Worksheets("AccountList").PageSetup.FirstPageNumber =
xlAutomatic
290 .Worksheets("AccountList").PageSetup.Order = xlDownThenOver
300 .Worksheets("AccountList").PageSetup.BlackAndWhite = False
310 .Worksheets("AccountList").PageSetup.Zoom = 73
320 .Worksheets("AccountList").PageSetup.PrintErrors =
xlPrintErrorsDisplayed
'Format Header Row
330 .Worksheets("AccountList").Select
340 Range("A1:I1").Select
350 With Selection.Interior
360 .ColorIndex = 36
370 .Pattern = xlSolid
380 End With
390 Selection.Interior.ColorIndex = 6
400 Cells.Select
410 Selection.COLUMNS.AutoFit
420 Range("E1").Select
430 ActiveCell.FormulaR1C1 = "Account #"
440 Range("H1").Select
450 ActiveCell.FormulaR1C1 = "A=Active" & Chr(10) & "R=Resolved"
460 With ActiveCell.Characters(Start:=1, Length:=19).Font
470 .Name = "MS Sans Serif"
480 .FONTSTYLE = "Regular"
490 .Size = 10
500 .Strikethrough = False
510 .Superscript = False
520 .Subscript = False
530 .OutlineFont = False
540 .Shadow = False
550 .Underline = xlUnderlineStyleNone
560 .ColorIndex = xlAutomatic
570 End With
580 Range("J1").Select
590 ActiveCell.FormulaR1C1 = "Resolution-Healthy,"
600 ActiveCell.FormulaR1C1 = _
"Resolution-Healthy," & Chr(10) & "Done (Paid Off, Final" &
Chr(10) & "Distrib.), Resigned"
610 With ActiveCell.Characters(Start:=1, Length:=61).Font
620 .Name = "MS Sans Serif"
630 .FONTSTYLE = "Regular"
640 .Size = 10
650 .Strikethrough = False
660 .Superscript = False
670 .Subscript = False
680 .OutlineFont = False
690 .Shadow = False
700 .Underline = xlUnderlineStyleNone
710 .ColorIndex = xlAutomatic
720 End With
730 Range("J1").Select
740 With Selection.Interior
750 .ColorIndex = 6
760 .Pattern = xlSolid
770 End With
780 Range("B1").Select
790 ActiveCell.FormulaR1C1 = "'Default" & Chr(10) & "Admin"
800 With ActiveCell.Characters(Start:=1, Length:=13).Font
810 .Name = "MS Sans Serif"
820 .FONTSTYLE = "Regular"
830 .Size = 10
840 .Strikethrough = False
850 .Superscript = False
860 .Subscript = False
870 .OutlineFont = False
880 .Shadow = False
890 .Underline = xlUnderlineStyleNone
900 .ColorIndex = xlAutomatic
910 End With
920 COLUMNS("A:A").Select
930 Selection.Insert Shift:=xlToRight
940 Range("A1").Select
950 ActiveCell.FormulaR1C1 = "#"
960 Range("A2").Select
970 COLUMNS("B:B").ColumnWidth = 7.11
980 Range("A1").Select
990 With Selection.Interior
1000 .ColorIndex = 6
1010 .Pattern = xlSolid
1020 End With
1030 Selection.ColumnWidth = 4.89
1040 Range("B1").Select
1050 Selection.ColumnWidth = 6.56
1060 Range("C1").Select
1070 Selection.ColumnWidth = 6.89
1080 Range("D1").Select
1090 Selection.ColumnWidth = 44.89
1100 Range("E1").Select
1110 Selection.ColumnWidth = 17.11
1120 Range("F1").Select
1130 Selection.ColumnWidth = 14.67
1140 Range("G1").Select
1150 ActiveWindow.SmallScroll ToRight:=5
1160 Selection.ColumnWidth = 14.78
1170 Range("H1").Select
1180 Selection.ColumnWidth = 12.11
1190 Range("I3").Select
1200 COLUMNS("I:I").ColumnWidth = 10.67
1210 Range("J1").Select
1220 Selection.ColumnWidth = 14.11
1230 Range("K1").Select
1240 Selection.ColumnWidth = 17.22
1250 Cells.Select
1260 With Selection
1270 .HorizontalAlignment = xlGeneral
1280 .VerticalAlignment = xlTop
1290 .WrapText = True
1300 .Orientation = 0
1310 .AddIndent = False
1320 .INDENTLEVEL = 0
1330 .ShrinkToFit = False
1340 .ReadingOrder = xlContext
1350 .MergeCells = False
1360 End With
1370 With Selection
1380 .HorizontalAlignment = xlLeft
1390 .VerticalAlignment = xlTop
1400 .WrapText = True
1410 .Orientation = 0
1420 .AddIndent = False
1430 .INDENTLEVEL = 0
1440 .ShrinkToFit = False
1450 .ReadingOrder = xlContext
1460 .MergeCells = False
1470 End With
1480 Rows("1:1").Select
1490 With Selection
1500 .HorizontalAlignment = xlLeft
1510 .VerticalAlignment = xlBottom
1520 .WrapText = True
1530 .Orientation = 0
1540 .AddIndent = False
1550 .INDENTLEVEL = 0
1560 .ShrinkToFit = False
1570 .ReadingOrder = xlContext
1580 .MergeCells = False
1590 End With
1600 Range("D7").Select
1610 Range("C2").Select
1620 x = 1
1630 If ActiveCell.Value <> "" Then
1640 testvalue = "Not Empty"
1650 Else
1660 testvalue = "Empty"
1670 End If
1680 Do Until testvalue = "Empty"
1690 ActiveCell.Offset(0, -2).Select
1700 ActiveCell.Value = x
1710 ActiveCell.Offset(1, 2).Select
1720 x = x + 1
1730 If ActiveCell.Value <> "" Then
1740 testvalue = "Not Empty"
1750 Else
1760 testvalue = "Empty"
1770 End If
1780 Loop
'Center Data in column A
1790 ActiveCell.COLUMNS("A:A").EntireColumn.Select
1800 With Selection
1810 .HorizontalAlignment = xlGeneral
1820 .WrapText = True
1830 .Orientation = 0
1840 .AddIndent = False
1850 .INDENTLEVEL = 0
1860 .ShrinkToFit = False
1870 .ReadingOrder = xlContext
1880 .MergeCells = False
1890 End With
1900 With Selection
1910 .HorizontalAlignment = xlCenter
1920 .WrapText = True
1930 .Orientation = 0
1940 .AddIndent = False
1950 .INDENTLEVEL = 0
1960 .ShrinkToFit = False
1970 .ReadingOrder = xlContext
1980 .MergeCells = False
1990 End With
2000 COLUMNS("G:G").Select
2010 Selection.Style = "Comma"
'Close the file
2020 excelFile.Save
2030 excelFile.Close
2040 End With
2050 excelApp.Quit
2060 Set excelFile = Nothing
2070 Set excelApp = Nothing
End Sub