UNE TABLE VERS EXCEL RAPIDE

Sub Lexcel(LaForm As Form)


On Error Resume Next


'Je met ma base a sa position de départ
LaForm.Adodc1.Recordset.MoveFirst

'Création d'un objet excel
Set A_EXCEL = CreateObject("Excel.Application")
'Ajout d'un nouveau classeur
A_EXCEL.Workbooks.Add
'Je créer mon tableau des valeur (le +1 est pour la ligne des champs)
je = A_EXCEL.Worksheets(1).Range(A_EXCEL.Worksheets(1).Cells(1, 1), A_EXCEL.Worksheets(1).Cells(LaForm.Adodc1.Recordset.RecordCount + 1, LaForm.Adodc1.Recordset.Fields.Count + 1)).Value

'Mise en forme de la ligne des nom de champs en Gras
    A_EXCEL.Worksheets(1).Rows("1:1").Select
    A_EXCEL.Selection.Font.Bold = True
    
'Initialisation des position des enregistrement
Nbeng = 1
'Initialisation des position dans les champs
Nbfs = 1

'Création de la ligne de Champs
   While Nbfs < LaForm.Adodc1.Recordset.Fields.Count
       je(Nbeng, Nbfs) = LaForm.Adodc1.Recordset(Nbfs - 1).Name
        Nbfs = Nbfs + 1
    Wend
'Je bouge dans mon tableau d'une ligne

Nbeng = Nbeng + 1

'Tant que ma base n'est pas vide

While LaForm.Adodc1.Recordset.EOF = False
'Je me positionne en au début des champs dans mon tableau
Nbfs = 1

'Je rentre toutes les valeur de l'enregistrement
   While Nbfs < LaForm.Adodc1.Recordset.Fields.Count
       je(Nbeng, Nbfs) = LaForm.Adodc1.Recordset(Nbfs - 1).Value
        Nbfs = Nbfs + 1
    Wend
' je passe a l'enregistrement Suivant
LaForm.Adodc1.Recordset.MoveNext
Nbeng = Nbeng + 1
Wend
'je remet mon tableau dans excel (un fois sur le canal)
A_EXCEL.Worksheets(1).Range(A_EXCEL.Worksheets(1).Cells(1, 1), A_EXCEL.Worksheets(1).Cells(LaForm.Adodc1.Recordset.RecordCount + 1, LaForm.Adodc1.Recordset.Fields.Count + 1)).Value = je

'Je mets en forme les bordure de mes définition de champs

    With A_EXCEL.Selection.Borders(7)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With A_EXCEL.Selection.Borders(8)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With A_EXCEL.Selection.Borders(9)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With A_EXCEL.Selection.Borders(10)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With A_EXCEL.Selection.Borders(11)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With


'Je créer un volet sur ma ligne de champs et je le fige

A_EXCEL.ActiveWindow.SplitRow = 1
A_EXCEL.ActiveWindow.FreezePanes = True

'Je me mets en filtre automatique
A_EXCEL.Rows("1:1").Select
A_EXCEL.Selection.AutoFilter


'J'étire mes collones

A_EXCEL.Cells.Select
A_EXCEL.Cells.EntireColumn.AutoFit


'Je me positionne en A1
A_EXCEL.Range("A1").Select


'Je rend excel visible a l'utilisateur

A_EXCEL.Visible = True



'Je met ma base a sa position de départ
LaForm.Adodc1.Recordset.MoveFirst
End Sub