Discussion :

[nicoweb371]

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 !

[ridan]

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

[nicoweb371]

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

Cool, merci bcp !

[avigeilpro]

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

[leroissejp]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[greenweed]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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. ]

[Megaxel]

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... ).
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.