autofit after loop?

[silentwolf]

Hi guys,

I am having troubles to put an autofit for the worksheet after a loop is executed..

Public Sub ObjekteInExcelSchreiben()
    Dim appExcel As Excel.Application
    Dim wbkExcel As Excel.Workbook
    Dim wksExel As Excel.Worksheet
    Dim rngExcel As Excel.Range
    Dim rcsO As Recordset
    Dim lngZeile As Long
    Dim lngZaehler As Long
    
    Set appExcel = Excel.Application
    Set wbkExcel = appExcel.Workbooks.Open(CurrentProject.Path & "\Regiebericht.xlsx", , , , , , , , , , , , False)
    appExcel.Visible = True

    Set wksExel = wbkExcel.Worksheets("Objekte")
    Set rngExcel = wksExel.UsedRange
    lngZeile = rngExcel.Rows.Count + rngExcel.Row - 1

    Set rcsO = CurrentDb.OpenRecordset("qryObjektMitKontakte")
    lngZaehler = lngZeile + 1
    
    Do Until rcsO.EOF
        wksExel.Cells(lngZaehler, 1).Value = rcsO.Fields("Obje_ID").Value
        wksExel.Cells(lngZaehler, 2).Value = rcsO.Fields("Obje_Name").Value
        wksExel.Cells(lngZaehler, 3).Value = rcsO.Fields("Obje_Adresse").Value
        wksExel.Cells(lngZaehler, 4).Value = rcsO.Fields("Obje_Ort").Value
        wksExel.Cells(lngZaehler, 5).Value = rcsO.Fields("Obje_Plz").Value
        wksExel.Cells(lngZaehler, 6).Value = rcsO.Fields("Land_Name").Value
        wksExel.Cells(lngZaehler, 7).Value = rcsO.Fields("Obje_Kont_Id_f").Value
        wksExel.Cells(lngZaehler, 8).Value = rcsO.Fields("KontaktName").Value
        
        rcsO.MoveNext
        lngZaehler = lngZaehler + 1
    Loop
End Sub

I tried to use autofit for the worksheeht after the loop like

wksExcel.UsedRange.Autofit

this line of code I have put after the loop from the above code..

Could someone please let me know where I need to put it correctly?


Many thanks

Silentwolf

 

[JackDanIce]

Hi, try:

Public Sub ObjekteInExcelSchreiben_v1()

    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim rcs As Recordset
    Dim x   As Long
    
    Set wkb = Workbooks.Open(CurrentProject.path & "\Regiebericht.xlsx", , , , , , , , , , , , False)
    Set wks = wkb.Sheets("Objekte")
    x = wks.Cells.find("*", wks.Cells(1, 1), , , , xlPrevious).row
    
    Set rcs = currentdb.openrecordset("qryObjektMitKontakte")
    
    Application.ScreenUpdating = False
    
    Do Until rcs.EOF
        With wks
            .Cells(x, 1).value = rcsO.Fields("Obje_ID").value
            .Cells(x, 2).value = rcsO.Fields("Obje_Name").value
            .Cells(x, 3).value = rcsO.Fields("Obje_Adresse").value
            .Cells(x, 4).value = rcsO.Fields("Obje_Ort").value
            .Cells(x, 5).value = rcsO.Fields("Obje_Plz").value
            .Cells(x, 6).value = rcsO.Fields("Land_Name").value
            .Cells(x, 7).value = rcsO.Fields("Obje_Kont_Id_f").value
            .Cells(x, 8).value = rcsO.Fields("KontaktName").value
            .Cells(x, 1).Resize(, 8).EntireColumn.AutoFit
        End With
        x = x + 1
    Loop
    
    Application.ScreenUpdating = True
    
    Set wkb = Nothing
    Set wks = Nothing
    Set rcs = Nothing
    
End Sub

 

[silentwolf]

Hi JackDanIce!

I am very sorry for not responding to your answer! I did not see it in my inbox!!!
Today I was searching again the net for my question and then I saw your reply!

It works !! Many thanks to you!

Again I am sorry for the late reply!!!

Silentwolf