День добрый.
Выгружаю в Excel массив данных с группировкой.
т.к. модуль заимствованный а знаний в этом направлении мало, не могу понять как убрать отступы от левого края (см. картинку).
Спасибо.

'Важно: должны быть установлены ссылки на DAO и на Excel object library
'Группировка в отчетах создается на ходу подразумевая настроенную в запросе сортировку по группам

Option Compare Database
Option Explicit

Const ReportTblName = "xОтчеты"
Const HeaderTblName = "xЗаголовок отчета"
Const FieldTblName = "xПоля"
Const ParameterTblName = "xПараметры запроса"

Public xl As Excel.Application
Public xlWb As Workbook
Public xlWs As Worksheet
Public R As Range
Private MainTotal As Integer

' Declare necessary API routines:
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long

Private Type HeaderType
  Text As String
  Row As Integer
  Col As Integer
  Align As Long '0;Лево;1;Центр;2;Право
  Bold As Integer
End Type

Private Type PageSetupType
  Init As Integer
  LeftMargin  As Double
  RightMargin  As Double
  TopMargin  As Double
  BottomMargin  As Double
  HeaderMargin  As Double
  FooterMargin  As Double
  Orientation As Long
End Type

Private Type FieldType
  Value As Variant
  PrevValue As Variant
  Name As String
  Head As String
  Status As Integer
  Col As Integer
  Width As Long
  Align As Long '0;Лево;1;Центр;2;Право
  Format As String '0;Групировка;1;Итог;2;Значение
  SubTotals As Integer
  IndentLevel As Integer
End Type

Private Type GroupType
  N As Integer
  Row As Integer
  Value As Variant
End Type

Public Ind As Long 'Индекс в БД
Public QueryName As String 'Имя запроса
Public Qd As DAO.QueryDef
Public Sort As String

Private Rs As DAO.Recordset
Private RsTemp As DAO.Recordset
Private QdTemp As DAO.QueryDef
Private Nm As String 'Имя отчета
Private TmplName As String 'Имя шаблона
Private StartTblRow As Integer
Private AllowColumnNames As Integer
Private FontName As Variant
Private FontSize As Variant
Private PageSetup As PageSetupType

Private CurRow As Long 'Текущая строка
Private Bold As Integer 'Итоги жирно

Private Headers() As HeaderType
Private HeaderCount As Integer
Private Totals() As Integer  'Номера полей, являющихся итогами
Private TotalCount As Integer
Private FirstGroups As Integer
Private Groups() As GroupType  'Номера полей, являющихся группами
Private GroupCount As Integer
Private Formulas() As String  'формулы итогов в группах (Группа, Итог)
Private Fields() As FieldType
Private FieldCount As Integer
Private sRow As Integer
Private eRow As Integer
Private sCol As Integer
Private eCol As Integer
Private TblRow As Integer
Public Property Set Recordset(RsIn As Recordset)
  Set Rs = RsIn.Clone
  If Rs.RecordCount <> 0 Then
    Rs.MoveFirst
  End If
End Property
Public Property Get Recordset()
  Set Recordset = Rs
End Property
Public Property Get HeaderCol(ByVal i As Integer) As Integer
  HeaderCol = Headers(i).Col
End Property
Public Property Let HeaderCol(ByVal i As Integer, ByVal Col As Integer)
  Headers(i).Col = Col
End Property
Public Property Get HeaderRow(ByVal i As Integer) As Integer
  HeaderRow = Headers(i).Row
End Property
Public Property Let HeaderRow(ByVal i As Integer, ByVal Row As Integer)
  Headers(i).Row = Row
End Property
Public Property Get HeaderText(ByVal i As Integer) As String
  HeaderText = Headers(i).Text
End Property
Public Property Let HeaderText(ByVal i As Integer, ByVal Text As String)
  Headers(i).Text = Text
End Property
Public Sub ResetHeaders(Optional ByVal N As Integer = 0)
  Dim i As Integer
  Erase Headers
  HeaderCount = N
  If N > 0 Then
    ReDim Headers(1 To N)
    For i = 1 To HeaderCount
      Headers(i).Align = xlHAlignLeft
      Headers(i).Bold = True
    Next i
  End If
End Sub
Public Sub EraseFields()
  Erase Totals
  TotalCount = 0
  Erase Groups
  GroupCount = 0
  Erase Formulas
  Erase Fields
  FieldCount = 0
End Sub

Public Property Get Name() As String
  Name = Nm
End Property
Public Sub LoadHeaders()
  Dim Rs As DAO.Recordset
  Dim i As Integer
  Set Rs = CurrentDb.OpenRecordset("Select * from [" + HeaderTblName + "] Where [Отчет]=" + CStr(Ind), dbOpenDynaset, dbSeeChanges)
  If Rs.RecordCount = 0 Then
    ResetHeaders
    Rs.Close
    Exit Sub
  End If
  Rs.MoveLast
  ResetHeaders Rs.RecordCount
  Rs.MoveFirst
  For i = 1 To HeaderCount
    Headers(i).Text = Nz(Rs![Текст], "")
    If Rs![Выравнивание] = 1 Then
      Headers(i).Align = xlHAlignCenter
    ElseIf Rs![Выравнивание] = 2 Then
      Headers(i).Align = xlHAlignRight
    Else
      Headers(i).Align = xlHAlignLeft
    End If
    Headers(i).Col = Rs![Столбец]
    Headers(i).Row = Rs![Строка]
    Headers(i).Bold = Nz(Rs![Жирность], False)
    Rs.MoveNext
  Next i
  Rs.Close
End Sub
Public Property Let Name(ByVal SNm As String)
  Dim Rs As DAO.Recordset
  Set Rs = CurrentDb.OpenRecordset("select * from [" + ReportTblName + "] where [Наименование]='" + SNm + "'", dbOpenDynaset, dbSeeChanges)
  If Rs.RecordCount = 0 Then
    Rs.Close
    Err.Raise 513, , "Отчет не найден"
    Exit Property
  End If
  Ind = Rs![Индекс]
  Bold = Nz(Rs![Группы жирно], False)
  QueryName = Nz(Rs![Запрос], "")
  FontName = Nz(Rs![Шрифт], "Ms SansSerif")
  FontSize = Nz(Rs![Размер], 8)
  TmplName = Nz(Rs![Шаблон], "")
  StartTblRow = Nz(Rs![Первая строка], 0)
  AllowColumnNames = Rs![Заголовки столбцов]
  If Rs![Итог] = True Then
    MainTotal = 0
  Else
    MainTotal = -1
  End If
  PageSetup.Init = True
  If IsNumeric(Rs!LeftMargin) Then
    PageSetup.LeftMargin = Rs!LeftMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!RightMargin) Then
    PageSetup.RightMargin = Rs!RightMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!TopMargin) Then
    PageSetup.TopMargin = Rs!TopMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!BottomMargin) Then
    PageSetup.BottomMargin = Rs!BottomMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!HeaderMargin) Then
    PageSetup.HeaderMargin = Rs!HeaderMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!FooterMargin) Then
    PageSetup.FooterMargin = Rs!FooterMargin
  Else
    PageSetup.Init = False
  End If
  If IsNumeric(Rs!Orientation) Then
    PageSetup.Orientation = Rs!Orientation
  Else
    PageSetup.Init = False
  End If

  
  Nm = SNm
  If QueryName <> "" Then
    Set Qd = CurrentDb.QueryDefs(QueryName)
  Else
    Set Qd = Nothing
  End If
  ResetHeaders 0
  EraseFields
  LoadFields
  Sort = ""
End Property

Public Sub LoadFields()
  Dim Rs As DAO.Recordset
  Dim i As Integer
  Dim K As Integer
  Dim M As Integer
  Dim li As Integer
  
  Dim Col As Integer
  EraseFields
  Set Rs = CurrentDb.OpenRecordset("Select * from [" + FieldTblName + "] Where [Отчет]=" + CStr(Ind) + " order by [Столбец];", dbOpenDynaset, dbSeeChanges)
  If Rs.RecordCount = 0 Then
    Rs.Close
    Exit Sub
  End If
  Rs.MoveLast
  FieldCount = Rs.RecordCount
  ReDim Fields(0 To FieldCount)
  Rs.MoveFirst
  GroupCount = 0
  TotalCount = 0
  For i = 1 To FieldCount
    Fields(i).Head = Nz(Rs![Заголовок], Rs![Имя])
    Fields(i).Name = Rs![Имя]
    Fields(i).Format = Nz(Rs![Формат], "General")
    Fields(i).Status = Rs![Статус]
    Fields(i).Width = Nz(Rs![Ширина], -1)
    If Rs![Выравнивание] = 1 Then
      Fields(i).Align = xlHAlignCenter
    ElseIf Rs![Выравнивание] = 2 Then
      Fields(i).Align = xlHAlignRight
    Else
      Fields(i).Align = xlHAlignLeft
    End If
    Fields(i).IndentLevel = 0
    If Fields(i).Status = 0 Then
      GroupCount = GroupCount + 1
    ElseIf Fields(i).Status = 1 Then
      TotalCount = TotalCount + 1
    End If
    Fields(i).Value = 0
    Fields(i).PrevValue = 0
    Fields(i).SubTotals = Nz(Rs![Итоги], 9)
    Rs.MoveNext
  Next i
  Rs.Close
  
  Fields(0).Align = xlHAlignLeft
  Fields(0).Value = "Всего"
  Fields(0).Status = 0
  Fields(0).Format = "General"
  Fields(0).Col = 1
  Fields(0).IndentLevel = 0
  
  Col = 1
  i = 1
  li = 0
  While Fields(i).Status = 0
    Fields(i).Col = 1
    Fields(i).Align = xlHAlignLeft
    Fields(i).Head = Fields(1).Head
    Fields(i).Width = Fields(1).Width
    If Col <= 15 Then
      Fields(i).IndentLevel = Col + MainTotal
    Else
      Fields(i).IndentLevel = 14
    End If
    li = Fields(i).IndentLevel + 1
    i = i + 0
    Col = Col + 0
  Wend
  FirstGroups = Col
  Col = 1
  For i = FirstGroups To FieldCount
    Fields(i).Col = Col
    Fields(i).IndentLevel = li
    li = 0
    Col = Col + 1
  Next i
  ReDim Groups(0 To GroupCount)
  If TotalCount > 0 Then
    ReDim Totals(1 To TotalCount)
  End If
  If TotalCount > 0 Then
    ReDim Formulas(0 To GroupCount, 1 To TotalCount)
  End If
  M = 1
  K = 0
  For i = 0 To FieldCount
    If Fields(i).Status = 0 Then
      Groups(K).N = i
      K = K + 1
    ElseIf Fields(i).Status = 1 Then
      Totals(M) = i
      M = M + 1
    End If
  Next i
End Sub

Public Sub LoadParameters()
  Dim Rs As DAO.Recordset
  On Error Resume Next
  Set Rs = CurrentDb.OpenRecordset("Select * from [" + ParameterTblName + "] Where [Отчет]=" + CStr(Ind), dbOpenDynaset, dbSeeChanges)
  While Not Rs.EOF
    If Rs![Тип] = 0 Then
      Qd.Parameters(Rs![Имя]) = CLng(Rs![Значение])
    ElseIf Rs![Тип] = 1 Then
      Qd.Parameters(Rs![Имя]) = CDbl(Rs![Значение])
    ElseIf Rs![Тип] = 2 Then
      Qd.Parameters(Rs![Имя]) = CDate(Rs![Значение])
    Else
      Qd.Parameters(Rs![Имя]) = Rs![Значение]
    End If
    Rs.MoveNext
  Wend
  Rs.Close
End Sub

Private Sub Class_Initialize()
  Set Qd = Nothing
  Set Rs = Nothing
  Set xl = Nothing
  Set xlWb = Nothing
  Set R = Nothing
  Sort = ""
  FontSize = Null
  ResetHeaders
  EraseFields
End Sub

Private Sub Class_Terminate()
  Set Qd = Nothing
  Set Rs = Nothing
  Set Qd = Nothing
  Set Rs = Nothing
  Set xl = Nothing
  Set xlWb = Nothing
  Set R = Nothing
  ResetHeaders
  EraseFields
End Sub
Private Function AddXlSheet() As Integer
  xl.Visible = False
  DoEvents
  AddXlSheet = False
  On Error Resume Next
  If TmplName <> "" Then
    Set xlWs = xlWb.Sheets.Add(Type:=TmplName, after:=xlWs)
  Else
    Set xlWs = xlWb.Add
  End If
  If Err.Number = 0 Then
    AddXlSheet = True
  End If
  Set R = xlWs.Cells
  SetXlSizes
  Err.Clear
End Function
Private Sub InitXlObjects()
  Dim i As Integer
  On Error Resume Next
  Set xl = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then
    Set xl = CreateObject("Excel.Application")
  End If
  DetectExcel
  On Error GoTo 0
  xl.Visible = False
  If TmplName <> "" Then
    Set xlWb = xl.Workbooks.Add(TmplName)
    Set xlWs = xlWb.Sheets(1)
  Else
    Set xlWb = xl.Workbooks.Add
    Set xlWs = xlWb.ActiveSheet
  End If
  Set R = xlWs.Cells
  SetXlSizes
  CurRow = 1
End Sub
Private Sub SetXlSizes()
  Dim i As Integer
  xlWs.Outline.SummaryRow = xlAbove
  xlWs.Outline.SummaryColumn = xlRight
  xlWs.Outline.AutomaticStyles = False
  If TmplName <> "" Then
    Exit Sub
  End If
  If Nz(FontName, "") <> "" Then
    R.Font.Name = FontName
  End If
  If IsNumeric(FontSize) Then
    R.Font.Size = FontSize
  End If
  If PageSetup.Init Then
    xlWs.PageSetup.LeftMargin = PageSetup.LeftMargin
    xlWs.PageSetup.RightMargin = PageSetup.RightMargin
    xlWs.PageSetup.TopMargin = PageSetup.TopMargin
    xlWs.PageSetup.BottomMargin = PageSetup.BottomMargin
    xlWs.PageSetup.HeaderMargin = PageSetup.HeaderMargin
    xlWs.PageSetup.FooterMargin = PageSetup.FooterMargin
    xlWs.PageSetup.Orientation = PageSetup.Orientation
  End If
  For i = 1 To FieldCount
    If Fields(i).Width >= 0 Then
      R.Columns(Fields(i).Col).ColumnWidth = Fields(i).Width
    End If
  Next i
End Sub

Private Sub OpenRecordset()
  Dim i As Integer
  If Not Rs Is Nothing Then
    Exit Sub
  End If
  If Sort <> "" Then
    Set QdTemp = CurrentDb.CreateQueryDef("", "Select * From [" + Qd.Name + "] order by " + Sort)
    For i = 0 To Qd.Parameters.Count - 1
      QdTemp.Parameters(Qd.Parameters(i).Name) = Qd.Parameters(i)
    Next i
    Set Rs = QdTemp.OpenRecordset
  Else
    Set Rs = Qd.OpenRecordset
  End If
End Sub

Private Sub FlashHeaders()
  Dim i As Integer
  For i = 1 To HeaderCount
    R(Headers(i).Row, Headers(i).Col).Value = Headers(i).Text
    R(Headers(i).Row, Headers(i).Col).HorizontalAlignment = Headers(i).Align
    R(Headers(i).Row, Headers(i).Col).Font.Bold = Headers(i).Bold
    If CurRow < Headers(i).Row Then
      CurRow = Headers(i).Row
    End If
  Next i
  CurRow = CurRow + 1
End Sub

Private Sub FlashTableHeaders()
  Dim i As Integer
  If AllowColumnNames <> True Then
    Exit Sub
  End If
  For i = 1 To FieldCount
    R(CurRow, Fields(i).Col).Value = Fields(i).Head
    R(CurRow, Fields(i).Col).HorizontalAlignment = xlHAlignCenter
    R(CurRow, Fields(i).Col).VerticalAlignment = xlVAlignCenter
    R(CurRow, Fields(i).Col).Font.Bold = True
    R(CurRow, Fields(i).Col).Borders.LineStyle = xlContinuous
    R(CurRow, Fields(i).Col).Borders.Weight = xlThin
    R(CurRow, Fields(i).Col).Interior.Color = 16777164
    R(CurRow, Fields(i).Col).WrapText = True
  Next i
  CurRow = CurRow + 1
End Sub
Private Sub LoadFieldValues()
  Dim i As Integer
  For i = 1 To FieldCount
    If Left(Fields(i).Name, 1) <> "=" Then
      Fields(i).Value = Rs.Fields(Fields(i).Name)
    ElseIf Mid(Fields(i).Name, 2, 1) = "#" Then
      Fields(i).Value = TblRow
    Else
      Fields(i).Value = Mid(Fields(i).Name, 2)
    End If
  Next i
End Sub
Private Sub InitGroups(ByVal lev As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim M As Integer
  
  If lev <= GroupCount Then
    For i = 1 To FieldCount
      Fields(i).PrevValue = 0
    Next i
  End If
    
  If lev = 0 And MainTotal = -1 Then
    Exit Sub
  End If
  
  If GroupCount = 0 And TotalCount = 0 Then
    Exit Sub
  End If
  For i = lev To GroupCount
    Groups(i).Row = CurRow
    M = Groups(i).N
    Groups(i).Value = Fields(M).Value
    R.Rows(CurRow).OutlineLevel = i + 1 + MainTotal '12/07
    R.Rows(CurRow).Font.Bold = Bold
    R(CurRow, Fields(M).Col).Value = Fields(M).Value
    R(CurRow, Fields(M).Col).HorizontalAlignment = Fields(M).Align
    If Fields(M).IndentLevel <> 0 Then
      R(CurRow, Fields(M).Col).IndentLevel = Fields(M).IndentLevel
    End If
    R(CurRow, Fields(M).Col).NumberFormat = Fields(M).Format
    For j = 1 To TotalCount
      M = Totals(j)
      R(CurRow, Fields(M).Col).HorizontalAlignment = Fields(M).Align
      If Fields(M).IndentLevel <> 0 Then
        R(CurRow, Fields(M).Col).IndentLevel = Fields(M).IndentLevel
      End If
      R(CurRow, Fields(M).Col).NumberFormat = Fields(M).Format
      Formulas(i, j) = "=SUBTOTAL(" + CStr(Fields(M).SubTotals) + "," + Rc(1, 0) + ":"
    Next j
    CurRow = CurRow + 1
  Next i
End Sub
Private Sub FlashFields()
  Dim i As Integer
  On Error Resume Next
  R.Rows(CurRow).Font.Bold = False
' R.Rows(CurRow).OutlineLevel = GroupCount + 2  ' Дерево свернуто
  R.Rows(CurRow).OutlineLevel = GroupCount      ' Дерево развернуто
  For i = FirstGroups To FieldCount
    R(CurRow, Fields(i).Col).NumberFormat = Fields(i).Format
    R(CurRow, Fields(i).Col).HorizontalAlignment = Fields(i).Align
    If Fields(i).IndentLevel <> 0 Then
      R(CurRow, Fields(i).Col).IndentLevel = Fields(i).IndentLevel
    End If
    If Fields(i).Status = 4 Then
      Fields(i).PrevValue = Fields(i).PrevValue + Fields(i).Value
      R(CurRow, Fields(i).Col).Value = Fields(i).PrevValue
    Else
      R(CurRow, Fields(i).Col).Value = Fields(i).Value
    End If
  Next i
  CurRow = CurRow + 1
End Sub
Private Sub CloseGroups(ByVal lev As Integer)
  Dim i As Integer
  Dim j As Integer
  On Error Resume Next
  If GroupCount = 0 And TotalCount = 0 Then
    Exit Sub
  End If
  If MainTotal = -1 And lev = 0 Then
    Exit Sub
  End If
  For i = GroupCount To lev Step -1
    For j = 1 To TotalCount
      Formulas(i, j) = Formulas(i, j) + Rc(CurRow - Groups(i).Row - 1, 0) + ")"
      R(Groups(i).Row, Fields(Totals(j)).Col).FormulaR1C1 = Formulas(i, j)
    Next j
  Next i
End Sub
Private Function Rc(ByVal Row As Integer, ByVal Col As Integer) As String
  Rc = "R[" + CStr(Row) + "]C[" + CStr(Col) + "]"
End Function

Private Sub FlashTable()
  Dim i As Integer
  Dim Flag As Integer
  If Qd Is Nothing Then
    Exit Sub
  End If
  OpenRecordset
  If Rs.EOF Then
    Rs.Close
    Exit Sub
  End If
  If StartTblRow > 0 Then
    CurRow = StartTblRow
    sRow = CurRow
  Else
    sRow = CurRow - 1
  End If
  TblRow = 1
  LoadFieldValues
  InitGroups 0
  While Not Rs.EOF
    LoadFieldValues
    Flag = True
    i = 1
    While Flag And (i <= GroupCount)
      ' группы одинаковые, если значение полей совпадают или Null
      If Groups(i).Value = Fields(Groups(i).N).Value Or (IsNull(Groups(i).Value) And IsNull(Fields(Groups(i).N).Value)) Then
        i = i + 1
      Else
        Flag = False
      End If
    Wend
    CloseGroups i
    InitGroups i
    FlashFields
    Rs.MoveNext
    TblRow = TblRow + 1
  Wend
  CloseGroups -MainTotal
  eRow = CurRow - 1
  sCol = 1
  eCol = Fields(FieldCount).Col
  Rs.Close
  R.Range(R(sRow, sCol), R(eRow, eCol)).Borders.LineStyle = xlContinuous
  R.Range(R(sRow, sCol), R(eRow, eCol)).Borders.Weight = xlThin
End Sub

Public Sub MakeXReport(Optional ByVal NewSheet As Integer = False)
  If NewSheet = False Then
    InitXlObjects
  ElseIf AddXlSheet() = False Then
    InitXlObjects
  End If
  FlashHeaders
  FlashTableHeaders
  FlashTable
  xlWs.Outline.ShowLevels 2
  xl.Visible = True
End Sub

Public Sub SaveColWidth()
  Dim Rs As DAO.Recordset
  Dim i As Integer
  On Error GoTo errcwEnd
  For i = 1 To FieldCount
    Fields(i).Width = 0 ' R.Columns(Fields(i).Col).ColumnWidth
  Next i
  PageSetup.LeftMargin = xlWs.PageSetup.LeftMargin
  PageSetup.RightMargin = xlWs.PageSetup.RightMargin
  PageSetup.TopMargin = xlWs.PageSetup.TopMargin
  PageSetup.BottomMargin = xlWs.PageSetup.BottomMargin
  PageSetup.HeaderMargin = xlWs.PageSetup.HeaderMargin
  PageSetup.FooterMargin = xlWs.PageSetup.FooterMargin
  PageSetup.Orientation = xlWs.PageSetup.Orientation
  PageSetup.Init = True
  Set Rs = CurrentDb.OpenRecordset("Select * from [" + FieldTblName + "] Where [Отчет]=" + CStr(Ind) + " order by [Столбец];", dbOpenDynaset, dbSeeChanges)
  For i = 1 To FieldCount
    Rs.Edit
    Rs![Ширина] = Fields(i).Width
    Rs.Update
    Rs.MoveNext
  Next i
  Rs.Close
  Set Rs = CurrentDb.OpenRecordset("Select * from [" + ReportTblName + "] Where [Индекс]=" + CStr(Ind), dbOpenDynaset, dbSeeChanges)
  Rs.Edit
  Rs!LeftMargin = PageSetup.LeftMargin
  Rs!RightMargin = PageSetup.RightMargin
  Rs!TopMargin = PageSetup.TopMargin
  Rs!BottomMargin = PageSetup.BottomMargin
  Rs!HeaderMargin = PageSetup.HeaderMargin
  Rs!FooterMargin = PageSetup.FooterMargin
  Rs!Orientation = PageSetup.Orientation
  Rs.Update
  Rs.Close
errcwEnd:
End Sub
Sub DetectExcel() ' откуда-то слямзил фирменный код - якобы позволяет не глючить каким-то версиям Excel (корректно отрабатывать GetObject)
' Procedure dectects a running Excel and registers it.
    Const WM_USER = 1024
    Dim hwnd As Long
' If Excel is running this API call returns its handle.
    hwnd = FindWindow("XLMAIN", 0)
    If hwnd = 0 Then    ' 0 means Excel not running.
        Exit Sub
    Else
    ' Excel is running so use the SendMessage API
    ' function to enter it in the Running Object Table.
        SendMessage hwnd, WM_USER + 18, 0, 0
    End If
End Sub

Public Property Let CellVal(ByVal Row As Integer, ByVal Col As Integer, CellValue As Variant)
  R(Row, Col).Value = CellValue
End Property

Public Property Get CellVal(ByVal Row As Integer, ByVal Col As Integer) As Variant
  CellVal = R(Row, Col).Value
End Property

http://www.sql.ru/forum/1265714/vygruzka-v-excel-pomogite-razobratsya-s-chuzhim-kodom