Export from Access with MySQL to Excel posts

Создаем самый главный наш скрипт экспорта из Access + MySQL в Excel в отдельном в модуле

'модуль формирования сводной таблицы по проекту
Option Compare Database 'сортировка символов определяется базой данных
Option Explicit 'запретить не объявленные переменные
Dim cnn As New ADODB.Connection
Const MySQLConnectString = "DSN=domen.net;SERVER=domen.net;UID=login;PORT=3306"
Dim rs As New ADODB.Recordset 'объект набора данных
Dim cmd As ADODB.Command
Dim EA As Excel.Application 'объект приложения Excel
Dim i As Integer, j, MyVal As Integer 'счетчики
Dim DA 'динамический массив для вывода данных
Const Шаблон As String = "\Справка.xlt" 'относительный путь к шаблону
Dim sq, Представление As String

   
Sub new1(Представление As String)
On Error Resume Next
    Set EA = CreateObject("Excel.Application") 'запускаем Excel
    EA.Workbooks.Add Template:=Application.CurrentProject.Path & Шаблон 'открываем шаблон
    EA.Cells.Select 'выделить все
    EA.Selection.Clear 'очистить
    'EA.Selection.NumberFormat = "@"  ' 0;-0;;@
    EA.Selection.NumberFormat = "0;-0;;@" ' формат: 0 - не показывать
   
   
Set cmd = New ADODB.Command
With cmd
.CommandTimeout = 60
End With
cnn.ConnectionString = "DSN=domen.net;SERVER=domen.net;UID=login;PORT=3306"
cnn.Open
sq = "SELECT * FROM db_name." & Представление

With rs
.ActiveConnection = cnn
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.Open sq
End With

'rs.Open Представление, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText
   
    ReDim DA(0 To 0, 0 To rs.Fields.Count - 1) 'выделяем память для заголовка таблицы
    For j = 0 To rs.Fields.Count - 1 'перебираем все поля функции
        DA(0, j) = rs.Fields(j).Name 'заносим имена полей в массив
    Next j
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Formula = DA 'выводим шапку таблицы
    Erase DA 'очищаем массив, освобождаем память
   
    rs.MoveLast 'переходим в конец для подсчёта количества строк в наборе данных
    ReDim DA(0 To rs.RecordCount - 1, 0 To rs.Fields.Count - 1) 'выделяем память для данных таблицы
    rs.MoveFirst 'возвращаемся в начало
    i = 0 'инициализируем счётчик строк
    Do While Not rs.EOF ' перебираем строки
        For j = 0 To rs.Fields.Count - 1 'перебираем поля
            DA(i, j) = rs(j) 'заносим данные в массив
        Next j
        rs.MoveNext 'читаем следующую строку набора данных
        i = i + 1 ' увеличить порядковый месяц
    Loop
    'выводим массив в таблицу
    EA.Range(EA.ActiveCell.Offset(1, 0), EA.ActiveCell.Offset(rs.RecordCount, rs.Fields.Count - 1)).Formula = DA
    'выводим массив в таблицу
    EA.Range(EA.ActiveCell.Offset(1, 0), EA.ActiveCell.Offset(rs.RecordCount, rs.Fields.Count - 1)).Formula = DA
        'фомат шапки таблицы
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).ColumnWidth = 10 'ширина всех колонок
    EA.Columns("A:A").ColumnWidth = 21 'ширина 1-ой колонки
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.Name = "Times New Roman"  'устанавливаем шрифт
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.Size = 10  'устанавливаем размер шрифта
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Font.FontStyle = "Bold"
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).WrapText = True 'перенос текста
    EA.Range(EA.ActiveCell.Offset(0, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).VerticalAlignment = xlTop 'выравнивание по высоте - верх
    'обрисуем границы
    EA.Range(EA.ActiveCell.Offset(i, rs.Fields.Count - 1), EA.ActiveCell.Offset(0, 0)).Borders(xlEdgeTop).Weight = xlThin  'подчёркиваем строку
    EA.Range(EA.ActiveCell.Offset(i, 0), EA.ActiveCell.Offset(0, 0)).Borders(xlEdgeBottom).Weight = xlThin  'подчёркиваем строку
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count)).Borders(xlInsideVertical).Weight = xlThin   ' чертим внутреннюю вертикаль
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count - 1)).Borders(xlEdgeLeft).Weight = xlThin  ' чертится линия слева
    EA.Range(EA.ActiveCell, EA.ActiveCell.Offset(i, rs.Fields.Count - 1)).Borders(xlInsideHorizontal).Weight = xlThin  ' чертим внутреннюю горизонталь
    EA.Range(EA.ActiveCell.Offset(i, 0), EA.ActiveCell.Offset(0, rs.Fields.Count - 1)).Borders(xlEdgeBottom).Weight = xlThin  'подчёркиваем строку
   
     EA.Cells.Select 'выделить все
     EA.Selection.Columns.AutoFit
     EA.Columns("D:D").ColumnWidth = 10
   
    'зафиксировать панель
    ' EA.Rows("1:1").Select
    ' EA.ActiveWindow.FreezePanes = True
   
    'сохраняем документ
    EA.ActiveWorkbook.SaveAs Application.CurrentProject.Path & "\" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & "_" & "_справка", xlExcel8, , , , , , True
   
    EA.Visible = True 'делаем Excel видимым
    Set EA = Nothing 'очищаем переменную и отключаемся от Excel
' --
    rs.Close 'закрываем набор данных
    Set rs = Nothing 'освобождаем память
 
'Set prm = Nothing
Set cmd = Nothing
'cnn.Close
Set cnn = Nothing
End Sub

Да, и не забудьте кнопку:

Private Sub Кнопка7_Click()
new1 (List5.Value)
End Sub