Option Explicit
Sub CreditCheck()
'CreditCheck Macro
'Macro recorded 04/04/2005 by Carryl Morgan
Dim oExcel As Excel.Application
Dim oExcelWB As Excel.Workbook
Dim oExcelWS As Excel.Worksheet
Dim myExcelFile As String
myExcelFile = "G:\Reservations\dave\Credit Control\Credit Controls.xls"
Set oExcel = New Excel.Application
Set oExcelWB = oExcel.Workbooks.Open(Filename:=myExcelFile)
Set oExcelWS = oExcelWB.ActiveSheet
oExcel.Visible = True
With oExcelWS
'
' CreditCheck Macro
' Macro recorded 04/04/2005 by Carryl Morgan
'
'
Rows("1:1").RowHeight = 39.6
Range("G2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""Exceeded"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""OK"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(2).Interior.ColorIndex = 35
Selection.Copy
Columns("G:G").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = True
Columns("C:E").Select
Selection.NumberFormat = "$#,##0.00"
Range("C2:F1215").Select
Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Select
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Cells.Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B11").Select
Selection.End(xlDown).Select
Range("B1215").Select
Selection.End(xlUp).Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(1.5748031496063)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.78740157480315)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 20
End With
End Sub
End With
If Not oExcel Is Nothing Then
oExcel.Application.Quit
Set oExcel = Nothing
End If
End Sub