My code is so slowly, so I guess I need help with the hole code I record from excel. Can someone help me to speed up this code and correct all misstakes I have made. I run this code from my VB project.
VB Code:
  1. Option Explicit

  2.  
  3. Private Const xlColumns = 2

  4. Private Const xlColumnStacked = 52

  5. Dim objGraph As Graph.Chart

  6.  
  7.  
  8. Function IsNothing(Obj As Object) As Boolean

  9. On Error Resume Next

  10.     IsNothing = True

  11.     

  12.     Obj.Name = Obj.Name 'Works even if Object doesn't have a name property

  13.     If Err.Number = 91 Then IsNothing = True

  14.  
  15. End Function

  16.  
  17.  
  18. Function IsExcelRunning() As Boolean

  19.    Dim xlApp As Excel.Application

  20.    On Error Resume Next

  21.  
  22.    Set xlApp = GetObject(, "Excel.Application")

  23.    IsExcelRunning = (Err.Number = 0)

  24.    Set xlApp = Nothing

  25.    Err.Clear

  26. End Function

  27.  
  28.  
  29. Private Function GetExcel() As Excel.Application

  30.    On Error Resume Next

  31.    Set GetExcel = GetObject(, "excel.application")

  32.    If Err.Number <> 0 Then Set GetExcel = New Excel.Application

  33. End Function

  34.  
  35.  
  36. Function OpenXLChange()

  37.  
  38.     Dim db As DAO.Database

  39.     Dim RS As DAO.Recordset

  40.     Dim SQL, PATH As String

  41.     Dim xlApp As Excel.Application

  42.     Dim xlBook As Excel.Workbook

  43.     Dim ExcelRunning As Boolean

  44.     Dim objGraph As Object

  45.     Set objGraph = frmForm1_Excel.OLE1.object ' I included a chart

  46.     

  47. ExcelRunning = IsExcelRunning()

  48. If ExcelRunning = False Then

  49. Set xlApp = CreateObject("Excel.application")

  50. Else

  51. Set xlApp = GetExcel

  52. End If

  53.  
  54. If IsNothing(xlApp) Then Set xlApp = New Excel.Application

  55.  
  56. PATH = "C:\"

  57.     

  58. Set xlBook = xlApp.Workbooks.Open(PATH & MyXl & ".xls")

  59.  
  60.    

  61.     xlBook.Application.Visible = False

  62.     xlApp.ScreenUpdating = False

  63.             

  64.             If frmForm1_Excel.ChkChart = vbChecked Then

  65.             With xlApp.Sheets.Add(After:=Sheets(1))

  66.                 xlApp.Sheets(2).Name = "Graf"

  67.             End With

  68.             End If

  69.             

  70.  
  71. xlApp.Sheets(1).Select

  72.  
  73.  With xlApp.Workbooks(1).BuiltinDocumentProperties

  74. .Item("Author").Value = "AuthorName"

  75. .Item("Manager").Value = "ManagerName"

  76. .Item("Title").Value = "TitleText"

  77. .Item("Company").Value = "TheCompany"

  78. .Item("Subject").Value = "SubjectText"

  79. .Item("Comments").Value = "Comments"

  80. End With

  81.  
  82.  
  83.     xlApp.ActiveSheet.PageSetup.PrintArea = ""

  84.     With xlApp.ActiveSheet.PageSetup

  85.         

  86.         .PrintTitleRows = "$1:$1"

  87.         .PrintTitleColumns = ""

  88.         .LeftHeader = ""

  89.         .CenterHeader = "TestText"

  90.         .RightHeader = "&""Arial,Regular""&8 Sidan &P av &N"

  91.         .LeftFooter = "&""Arial,Regular""&8 TestNr2/&F/TestNr4/&D"

  92.         .CenterFooter = ""

  93.         .RightFooter = "&""Times New Roman,Normal""&3Automatic Created"

  94.         .LeftMargin = xlApp.Application.InchesToPoints(0)

  95.         .RightMargin = xlApp.Application.InchesToPoints(0)

  96.         .TopMargin = xlApp.Application.InchesToPoints(0.984251969)

  97.         .BottomMargin = xlApp.Application.InchesToPoints(0.984251969)

  98.         .HeaderMargin = xlApp.Application.InchesToPoints(0.5)

  99.         .FooterMargin = xlApp.Application.InchesToPoints(0.5)

  100.         .PrintHeadings = False

  101.         .PrintGridlines = False

  102.         .PrintComments = xlPrintNoComments

  103.         .CenterHorizontally = False

  104.         .CenterVertically = False

  105.         .Orientation = xlLandscape

  106.         .Draft = False

  107.         .PaperSize = xlPaperA4

  108.         .FirstPageNumber = xlAutomatic

  109.         .Order = xlDownThenOver

  110.         .BlackAndWhite = False

  111.         .Zoom = 100

  112.  End With

  113.  
  114.  
  115.  
  116.     xlApp.Range("A1:S1").Select

  117.     With xlApp.Selection.Interior

  118.         .ColorIndex = 15

  119.         .Pattern = xlSolid

  120.     End With

  121.     

  122.     xlApp.Cells.Select

  123.     With xlApp.Selection.Font

  124.         .Name = "MS Sans Serif"

  125.         .Size = 8.5

  126.         .Strikethrough = False

  127.         .Superscript = False

  128.         .Subscript = False

  129.         .OutlineFont = False

  130.         .Shadow = False

  131.         .Underline = xlUnderlineStyleNone

  132.         .ColorIndex = xlAutomatic

  133.     End With

  134.     

  135.     xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone

  136.     xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

  137.     With xlApp.Selection.Borders(xlEdgeLeft)

  138.         .LineStyle = xlContinuous

  139.         .Weight = xlThin

  140.         .ColorIndex = 15

  141.     End With

  142.     With xlApp.Selection.Borders(xlEdgeTop)

  143.         .LineStyle = xlContinuous

  144.         .Weight = xlThin

  145.         .ColorIndex = 15

  146.     End With

  147.     With xlApp.Selection.Borders(xlEdgeBottom)

  148.         .LineStyle = xlDouble

  149.         .Weight = xlThin

  150.         .ColorIndex = 15

  151.     End With

  152.     With xlApp.Selection.Borders(xlEdgeRight)

  153.         .LineStyle = xlContinuous

  154.         .Weight = xlThin

  155.         .ColorIndex = 15

  156.     End With

  157.     With xlApp.Selection.Borders(xlInsideVertical)

  158.         .LineStyle = xlContinuous

  159.         .Weight = xlThin

  160.         .ColorIndex = 15

  161.     End With

  162.     

  163.         With xlApp.Selection.Borders(xlInsideHorizontal)

  164.         .LineStyle = xlContinuous

  165.         .Weight = xlThin

  166.         .ColorIndex = 15

  167.     End With

  168.  
  169.     xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone

  170.     xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

  171.     

  172.     xlApp.Rows("1:1").Select

  173.    With Selection

  174.         .HorizontalAlignment = xlCenter

  175.         .VerticalAlignment = xlBottom

  176.         .WrapText = False

  177.         .Orientation = 0

  178.         .AddIndent = False

  179.         .ShrinkToFit = False

  180.         .MergeCells = False

  181.     End With

  182.  
  183.     xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone

  184.     xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

  185.     With xlApp.Selection.Borders(xlEdgeLeft)

  186.         .LineStyle = xlContinuous

  187.         .Weight = xlThin

  188.         .ColorIndex = xlAutomatic

  189.     End With

  190.     With xlApp.Selection.Borders(xlEdgeTop)

  191.         .LineStyle = xlContinuous

  192.         .Weight = xlThin

  193.         .ColorIndex = xlAutomatic

  194.     End With

  195.     With xlApp.Selection.Borders(xlEdgeBottom)

  196.         .LineStyle = xlDouble

  197.         .Weight = xlThick

  198.         .ColorIndex = xlAutomatic

  199.     End With

  200.     With xlApp.Selection.Borders(xlEdgeRight)

  201.         .LineStyle = xlContinuous

  202.         .Weight = xlThin

  203.         .ColorIndex = xlAutomatic

  204.     End With

  205.     With xlApp.Selection.Borders(xlInsideVertical)

  206.         .LineStyle = xlContinuous

  207.         .Weight = xlThin

  208.         .ColorIndex = xlAutomatic

  209.     End With

  210.  
  211.     xlApp.Columns("D:E").Select

  212.     xlApp.Selection.NumberFormat = "yyyy-mm-dd"

  213.     xlApp.Columns("H:S").Select

  214.     xlApp.Selection.AutoFilter

  215.     

  216.     xlApp.Cells.Select

  217.     xlApp.Cells.EntireColumn.AutoFit

  218.     

  219.     xlApp.ActiveWindow.View = xlPageBreakPreview

  220.     xlApp.ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1

  221.     xlApp.ActiveWindow.View = xlNormalView

  222.     

  223.     xlApp.Range("A1").Select

  224.     

  225.     SQL = "Mys SQL statement"

  226.     

  227.     Set db = OpenDatabase(GetTmpPath & "TestMDB.MDB", False, True, ";pwd=******")

  228.     Set RS = db.OpenRecordset(SQL, dbOpenDynaset)

  229.  
  230.     While Not RS.EOF

  231.     With xlApp.Range("A" & RS.AbsolutePosition + 2).AddComment

  232.     .Visible = False

  233.     .Text Text:=RTrim(RS.FIELDS("Name").Value) & Chr(10) & _

  234.     "Faxnr: " & RTrim(RS.FIELDS("FaxNumber"))

  235.     .Shape.ScaleWidth 1.63, False

  236.     .Shape.ScaleHeight 1.38, False

  237.     End With

  238.     RS.MoveNext

  239.     Wend

  240.     RS.Close

  241.     

  242.  
  243.    If frmForm1_Excel.ChkChart = vbChecked Then

  244.     xlApp.Sheets("Graf").Select

  245.     objGraph.ChartArea.Copy

  246.     xlApp.Cells.Select

  247.     xlApp.ActiveSheet.Paste

  248.     

  249.     xlApp.ActiveSheet.Shapes("Object 1").Select ' Here is the copied chart

  250.     xlApp.Selection.ShapeRange.ScaleWidth 0.88, False

  251.     With xlApp.ActiveSheet.PageSetup

  252.         

  253.         .PrintTitleRows = "$1:$1"

  254.         .PrintTitleColumns = ""

  255.         .LeftHeader = ""

  256.         .CenterHeader = "TestText"

  257.         .RightHeader = "&""Arial,Regular""&8 Sidan &P av &N"

  258.         .LeftFooter = "&""Arial,Regular""&8 TestNr2/&F/TestNr4/&D"

  259.         .CenterFooter = ""

  260.         .RightFooter = "&""Times New Roman,Normal""&3Automatic Created"

  261.         .LeftMargin = xlApp.Application.InchesToPoints(0)

  262.         .RightMargin = xlApp.Application.InchesToPoints(0)

  263.         .TopMargin = xlApp.Application.InchesToPoints(0.984251969)

  264.         .BottomMargin = xlApp.Application.InchesToPoints(0.984251969)

  265.         .HeaderMargin = xlApp.Application.InchesToPoints(0.5)

  266.         .FooterMargin = xlApp.Application.InchesToPoints(0.5)

  267.         .PrintHeadings = False

  268.         .PrintGridlines = False

  269.         .PrintComments = xlPrintNoComments

  270.         .CenterHorizontally = False

  271.         .CenterVertically = False

  272.         .Orientation = xlLandscape

  273.         .Draft = False

  274.         .PaperSize = xlPaperA4

  275.         .FirstPageNumber = xlAutomatic

  276.         .Order = xlDownThenOver

  277.         .BlackAndWhite = False

  278.         .Zoom = 100

  279.     End With

  280.     

  281.     Set objGraph = Nothing

  282.     End If

  283.  
  284. xlBook.Save

  285. xlBook.Close

  286.  
  287. xlApp.Quit

  288.          

  289.         Set xlBook = Nothing

  290.         Set xlApp = Nothing

  291.         Set db = Nothing

  292.         Set RS = Nothing

  293.  
  294. End Function