Une table vers excel rapide

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 730 fois - Téléchargée 42 fois

Contenu du snippet

Création d'un tableau et l'injecté directement dans Excel a prtir d'une base de données

Rapide car l'envoie des données est sur selection d'excel.

Laform est la feuille ou j'ai mit mon controle ADODC , pour l'execute placer un controle
ADODC sur une form connecté le a votre base de données, mettre un bouton qui a pour Action : Lexcel Me

Source / Exemple :


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

A voir également

Ajouter un commentaire

Commentaires

rebelzkikione
Messages postés
5
Date d'inscription
mercredi 12 mars 2003
Statut
Membre
Dernière intervention
29 juin 2004

Merci :),
je n'avais pas vu ton bout de code ! j'utilise cette méthode "copyfromrecordset" car quand tu as des recordsets que tu construis à la main (sans etre attaché à une BD...) ben il y a plus beaucoup de solution ;)

Merci encore ;)

Ciao
cs_Benouille
Messages postés
216
Date d'inscription
jeudi 24 octobre 2002
Statut
Membre
Dernière intervention
7 septembre 2007
1
ouaip bien vu rebelzikione, ou par msquery en attachant le classeur à sa donnée (permet en outre des refresh depuis excel sans aide exterieurs) : http://www.vbfrance.com/code.aspx?ID=28101

vb nouille
cs_Benouille
Messages postés
216
Date d'inscription
jeudi 24 octobre 2002
Statut
Membre
Dernière intervention
7 septembre 2007
1
ouaip bien vu rebelzikione, ou par msquery en attachant le classeur à sa donnée (permet en outre des refresh depuis excel sans aide exterieurs) : http://www.vbfrance.com/code.aspx?ID=28101

vb nouille
rebelzkikione
Messages postés
5
Date d'inscription
mercredi 12 mars 2003
Statut
Membre
Dernière intervention
29 juin 2004

ça devrait être utile les p'tits loup pour un export direct d'un recordset dans doc excel ;)

Function CopyFromRecordset(Data As Unknown, [MaxRows], [MaxColumns]) As Long
zheRefaik
Messages postés
3
Date d'inscription
mardi 23 mars 2004
Statut
Membre
Dernière intervention
30 avril 2008

salut

Je n’ais pas assait d’expérience pour critiqué votre Code mais je voudrais bien avoir les déclaration svp

merci

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.