creer fichier excel

Bonjour à tous,

Débutant en VB, je souhaiterais à partir de mon applis creer un fichier excel et y ajouter des données à l'intérieur selon un certain ordre.

Je m'explique :
Je recupere des infos d'un fichier que je lis ligne par ligne. Chaque ligne comprends plusieurs éléments que je recupere en fonction de leur position. Chaque éléments correspond à un titre.

Donc j'aimerais dans mon fichier excel :
mettre en entête de colone le titre de mes éléments et ensuite ligne par ligne les valeurs correspondantes.

J'espère que j'ai été assez claire ?
Merci !

Pilotage d'Excel avec VB : http://drq.developpez.com/vb/tutoriels/Excel/ :wink:

Citation:

---

Envoyé par ridan

Pilotage d'Excel avec VB : http://drq.developpez.com/vb/tutoriels/Excel/ :wink:

---

Cool, merci bcp !

si tu n'as plus de question portant sur ce sujet, n'oublie pas le tag :resolu: :wink:

Bonsoir,
Dans Projet / Références, cocher la référence à Excel.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Private Sub Command2_Click() Dim objXL As New Excel.Application Dim wbXL As New Excel.Workbook Dim wsXL As New Excel.Worksheet If Not IsObject(objXL) Then MsgBox "Vous Avez Besoin de Microsoft Excel pour cette Fonction", vbExclamation, "Excel" Exit Sub End If ' Ouvre Excel objXL.Visible = True Set wbXL = objXL.Workbooks.Add Set wsXL = objXL.ActiveSheet   Range("A1").Value = "Titre" Range("B1").Value = "Titre 1" Range("C1").Value = "Titre 3" End Sub

---

jpleroisse

Bonjour,

Créer un fichier Excel avec VB 6 est un jeu d'enfant.

Le plus compliqué est la mise en page. Conseil, ouvrir un classeur Excel et créer une macro pour, par exemple, colorier une cellule et ensuite décortiquer le code (Outil/Macro/Macro et sélectionner la macro puis la visualiser en cliquant sur "modifier").

Pour commencer aller dans Projet/Références et cocher "Microsoft Excel 9.0 object Library.

Voici un code que j'ai créé pour éditer un devis.

Bon courage

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214

Dim X As New Excel.Application Dim i Dim q Dim LotX, IntituléX, InfoLot Dim ligne, MOuv, Site, Site2, Descro, Lot, Intitulé ligne = 14   MOuv = 2 'variables donnant la position, 2 = 2ème ligne à partir du haut Site = 3 Site2 = 4 Descro = 5 Lot = 7 Intitulé = 8     Dim Cible$, SourceX SourceX = App.Path & "\Fichiers de gestion\Estime.xlt"   'wwwwwwwwwwwwwwwwwwwwwwwwwwww Dim Fichier$, Fic$, FicCourt$ Dim Lnom, LnomMini   X.Workbooks.Open (SourceX) X.Application.Visible = True   With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(MOuv, 1) = ado_ClientsBde![COMMUNE] .Cells(Site, 1) = ado_ClientsBde![Site1] '.Cells(Site2, 1) = ado_ClientsBde![Site2] .Cells(Descro, 1) = ado_ClientsBde![Descro] .Cells(Lot, 1) = InfoLot   End With   X.ActiveWorkbook.Worksheets("Feuil1").Cells(14, 1) = ""   Ado_Estime.MoveFirst   Do Until Ado_Estime.EOF   If Ado_Estime![Num] <> 1 Then   With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 1) = Ado_Estime![NUMERO] .Cells(ligne, 2) = Ado_Estime![NUMERO LIBRE] .Cells(ligne, 2).HorizontalAlignment = xlCenter   .Cells(ligne, 3) = Ado_Estime![DEFINITION] If Ado_Estime![Num] = 2 Then .Cells(ligne, 3).Font.Bold = True   .Cells(ligne, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 1).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 2).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 3).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 4).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 6).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous   End If .Cells(ligne, 4) = Ado_Estime![UNITE] .Cells(ligne, 5) = Ado_Estime![QUANTITES] .Cells(ligne, 6) = Ado_Estime![PRIX UNITAIRE] .Cells(ligne, 7) = "=RC[-2]*RC[-1]" 'frmCréation.labPU * frmCréation.labQuant   .Cells(ligne, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 1).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 2).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 3).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 4).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 6).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous   If Ado_Estime![Num] = 2 Then .Cells(ligne, 7).FormulaR1C1 = ""   End If   ligne = ligne + 1   'ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"   End With End If   Ado_Estime.MoveNext Loop   ligne = ligne 'ligne = 14 + 1 + N   With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 1).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 2).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 3).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 4).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 6).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 6).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous   End With     Dim Lieu, FonctSign, Signataire, TVA Lieu = ado_Param![Lieu] FonctSign = ado_Param![FONCTION SIGNATAIRE] Signataire = ado_Param![Signataire] TVA = ado_Param![TVA]   ligne = ligne + 2   X.ActiveWorkbook.Worksheets("Feuil1").Cells(ligne, 3) = Lieu & " le " & Date X.ActiveWorkbook.Worksheets("Feuil1").Cells(ligne, 3).HorizontalAlignment = xlLeft   Dim Formule1, Formule2, Formule3, Gén Formule1 = "=SUM(R[-" Formule2 = N + 2 Formule3 = "]C:R[-3]C)" Gén = Formule1 & Formule2 & Formule3 '=SUM(R[-N+2]C:R[-1]C)   With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 7).FormulaR1C1 = Gén   .Cells(ligne, 6) = "Montant HT" .Cells(ligne, 6).HorizontalAlignment = xlRight .Cells(ligne, 6).WrapText = False   .Cells(ligne, 5).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeTop).LineStyle = xlContinuous .Cells(ligne, 5).Interior.ColorIndex = 19   .Cells(ligne, 6).Borders(xlEdgeTop).LineStyle = xlContinuous .Cells(ligne, 6).Interior.ColorIndex = 19   .Cells(ligne, 7).Borders(xlEdgeTop).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Interior.ColorIndex = 19   End With   ligne = ligne + 1 With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 2) = FonctSign .Cells(ligne, 2).HorizontalAlignment = xlLeft   .Cells(ligne, 5) = "TVA" .Cells(ligne, 5).HorizontalAlignment = xlRight .Cells(ligne, 6) = TVA .Cells(ligne, 6).HorizontalAlignment = xlRight .Cells(ligne, 6).WrapText = False   ' "=R[-1]C*RC[-1]/100" .Cells(ligne, 7).FormulaR1C1 = "=R[-1]C*RC[-1]/100" .Cells(ligne, 5).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 5).Interior.ColorIndex = 19 .Cells(ligne, 6).Interior.ColorIndex = 19 .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Interior.ColorIndex = 19 .Cells(ligne, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous   End With   ligne = ligne + 1 With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 6) = "Montant TTC" .Cells(ligne, 6).HorizontalAlignment = xlRight .Cells(ligne, 6).WrapText = False   .Cells(ligne, 6).Font.Bold = True .Cells(ligne, 7).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" .Cells(ligne, 7).Interior.ColorIndex = 15   .Cells(ligne, 5).Borders(xlEdgeLeft).LineStyle = xlContinuous .Cells(ligne, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 5).Interior.ColorIndex = 19   .Cells(ligne, 6).Borders(xlEdgeBottom).LineStyle = xlContinuous .Cells(ligne, 6).Interior.ColorIndex = 19   .Cells(ligne, 7).Borders(xlEdgeRight).LineStyle = xlContinuous .Cells(ligne, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous   End With   ligne = ligne + 2   With X.ActiveWorkbook.Worksheets("Feuil1") .Cells(ligne, 3) = Signataire .Cells(ligne, 3).HorizontalAlignment = xlCenter   End With     ' wwwwwwwwwwww ' mise à jour de l'en tête   LotX = ado_ClientsBde![INDICE LOT] IntituléX = ado_ClientsBde![INTITULE LOT]   If LotX = "" And IntituléX = "" Then InfoLot = "" ElseIf LotX <> "" And IntituléX <> "" Then InfoLot = "Lot " & LotX & " - " & IntituléX End If

---

[Balises "Code" ajoutées par AlainTech]
[Pensez-y vous-même à l'avenir. Merci.:wink: ]

Oui, c'est vrai que le code de mise en forme est souvent long (quoi que ça peut être joli, en utilisant les balises de code... :D ).
Personnellement, j'utilise 2 "techniques":
1-si ce n'est pas trop long, je fais une procédure de mise en forme, à laquelle je passe en paramètre le nom de l'onglet. Ça permet de ne pas rendre le code "applicatif" trop illisible.
2-je crée un onglet "template", vide, et ayant la mise en forme que je veux. Et je cache cet onglet pour ne pas embrouiller les utilisateurs. Et j'en fais une copie quand j'en ai besoin. En plus, une modification du 'look' est simple: il suffit de faire réapparaître l'onglet, de le modifier, puis de la re-masquer.