AutoFit

Понедельник, 10 Июля 2017 г. 10:21 + в цитатник

Доброго времени суток всем!

Подскажите пожалуйста, как можно применить AutoFit при открытии файла Excel?

Файл Excel создаю из Access таким способом:

Private Sub knExpExcel_Click()
On Error GoTo Err_knExpExcel_Click

Dim obj As Object

On Error Resume Next
Kill ("D:\Base_dolgi\РеестрОплаты.xls")

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "zExpExcel2", "D:\Base_dolgi\РеестрОплаты.xls", True

Set obj = GetObject("D:\Base_dolgi\РеестрОплаты.xls")

With obj

.Application.Visible = True
.Parent.Windows(1).Visible = True
.Columns(2).Autofit  ' тут пытаюсь применить AutoFit
.Columns("A:D").EntireColumn.Autofit  ' и тут другим макаром пытаюсь применить Autofit

End With

Set obj = Nothing

Exit_knExpExcel_Click:
    Exit Sub

Err_knExpExcel_Click:
    MsgBox Err.Description
    Resume Exit_knExpExcel_Click
    
End Sub

Уже второй день форум штудирую, но что-то никак не хватает понимания, как это сделать. Никак не получается ширину столбцов увеличить автоматически (массу способов попробовал).

Вот так получается (модуль готовый взял, кажется на этом форуме, немного подогнал свои нужды):

Sub ToExcelFinal_2()
On Error GoTo Err_
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim rsd As DAO.Recordset
Dim i As Byte

    Set xlApp = CreateObject("Excel.Application")
   
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    
    Set rsd = CurrentDb.OpenRecordset("SELECT tFizlicaReestr.LS AS ЛС, tFizlicaReestr.FIO AS ФИО , tFizlicaReestr.Adres AS Адрес, Null AS Оплата" & _
                                     " FROM tFizlicaReestr INNER JOIN tRabotaReestr ON tFizlicaReestr.LS = tRabotaReestr.LS " & _
                                     " WHERE tRabotaReestr.DataDobavleniaGraf = #" & Format([Forms]![fExpExcel]![pData], "mm\/dd\/yyyy") & "# " & _
                                     " GROUP BY tFizlicaReestr.LS, tFizlicaReestr.FIO, tFizlicaReestr.Adres, Null " & _
                                     " ORDER BY tFizlicaReestr.LS", dbOpenSnapshot)
    For i = 0 To rsd.Fields.Count - 1
        xlSheet.Cells(1, i + 1) = rsd.Fields(i).Name
    Next i
    xlSheet.Range("A2").CopyFromRecordset rsd
    xlSheet.Columns(1).Autofit
    xlSheet.Columns(2).Autofit
    xlSheet.Columns(3).Autofit
    
    rsd.Close
     
    Set rsd = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlApp = Nothing
        
Exit Sub
Err_:
End Sub