ecrire dans excel

Correction Cellule

Re

Comme promis voici un exemple très sommaire mais qui marche.
Commence par créer un répertoire Essai directement sous C :
Enregistre un fichier Excel dans ce répertoire que tu nommeras Essai.xls (Je sais c’est extrêmement recherché comme nom). Sur la feuille 1 : A1 = Qté, B1 = Désignation et C1 = Prix
Ouvre un nouveau projet sous VB avec une Form sur la quelle tu place un groupe de textbox appelé Text1(0), Text1(1) et Text1(2). Ajout trois bouton de commande appelé Cmd1, Cmd2 et Cmd3. Appelle les boutons Cmd1=transfert dans excel, Cmd2=Creation du tableau, Cmd3 = réinitialiser le tableau et la base
Recopie le code suivant dans la forme.

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
Option Explicit
Public II, JJ, Lg, Lg1, Lg2, LgMax As Integer
'II variable pour boucle For Next sur feuille 2
'JJ variable pour boucle For Next sur feuille 1
'Lg variable pour incrémentation des lignes en création
'Lg1 et Lg2 variable pour séléction des enregistrements
'LgMax variable pour mémoriser la ligne du dernier enregistrement
 
'Déclaration pour le chargement d'excel
Dim XlsApp As Excel.Application
Dim xlsBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim xlsheet1 As Excel.Worksheet
 
Private Sub Cmd1_Click() 'Transfert dans la base excel
 
'Ouverture d'Excel
Set XlsApp = New Excel.Application
Set xlsBook = XlsApp.Workbooks.Open("c:\essai\essai.xls")
Set xlsheet = xlsBook.Worksheets(2)
 
XlsApp.Visible = False
 
'Transfert des données
Lg = Lg + 1
 
xlsheet.Cells(Lg, 1) = Text1(0).Text
xlsheet.Cells(Lg, 2) = Text1(1).Text
xlsheet.Cells(Lg, 3) = Text1(2).Text
 
'Enregistrement et fermeture d'excel
xlsBook.Save
xlsBook.Close
Excel.Application.Quit
Set xlsheet = Nothing
Set xlsBook = Nothing
Set XlsApp = Nothing
 
'Réinitialisation des textbox
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
 
'Sauvegarde du dernier n° de ligne créé
LgMax = Lg
 
End Sub
 
Private Sub Cmd2_Click()    'Transfert de la base excel au tableau
 
'Ouverture d'Excel
Set XlsApp = New Excel.Application
Set xlsBook = XlsApp.Workbooks.Open("c:\essai\essai.xls")
Set xlsheet = xlsBook.Worksheets(2)
Set xlsheet1 = xlsBook.Worksheets(1)
 
XlsApp.Visible = False
 
'Suppression des données du tableau
For JJ = 2 To 3 'dans cette exemple je traite les lignes 2 par 2
 
xlsheet1.Cells(JJ, 1) = ""
xlsheet1.Cells(JJ, 2) = ""
xlsheet1.Cells(JJ, 3) = ""
 
Next JJ
 
'transfert des lignes
JJ = 1
 
'Teste des n° de ligne
'Je ne suis pas en fin de base donc je transfert
If Lg1 < LgMax And Lg2 <= LgMax Then
For II = Lg1 To Lg2
 
JJ = JJ + 1
 
xlsheet1.Cells(JJ, 1) = xlsheet.Cells(II, 1)
xlsheet1.Cells(JJ, 2) = xlsheet.Cells(II, 2)
xlsheet1.Cells(JJ, 3) = xlsheet.Cells(II, 3)
 
Next II
 
'j'arrive en fin de base je réajuste les variables en fonction des n° de ligne
ElseIf Lg1 < LgMax And Lg2 > LgMax Then
    Lg2 = LgMax
 
For II = Lg1 To Lg2
 
JJ = JJ + 1
 
xlsheet1.Cells(JJ, 1) = xlsheet.Cells(II, 1)
xlsheet1.Cells(JJ, 2) = xlsheet.Cells(II, 2)
xlsheet1.Cells(JJ, 3) = xlsheet.Cells(II, 3)
 
Next II
 
 
ElseIf Lg1 = LgMax And Lg2 > LgMax Then
    Lg2 = LgMax
 
For II = Lg1 To Lg2
 
JJ = JJ + 1
 
xlsheet1.Cells(JJ, 1) = xlsheet.Cells(II, 1)
xlsheet1.Cells(JJ, 2) = xlsheet.Cells(II, 2)
xlsheet1.Cells(JJ, 3) = xlsheet.Cells(II, 3)
 
Next II
 
'je n'est plus d'enregistrements
ElseIf Lg1 > LgMax Then
    MsgBox "transfert terminé"
End If
 
XlsApp.Visible = True
 
MsgBox "Vous pouvez poursuivre le transfert des données"
 
'Fermeture d'Excel
Excel.Application.Quit
Set xlsheet = Nothing
Set xlsBook = Nothing
Set XlsApp = Nothing
 
Lg1 = Lg2 + 1
Lg2 = Lg1 + 1 '1 étant le nombre de ligne du tableau
 
End Sub
 
Private Sub Cmd3_Click() 'Suppression des données dans la base et le tableau
'Ouverture d'Excel
Set XlsApp = New Excel.Application
Set xlsBook = XlsApp.Workbooks.Open("c:\essai\essai.xls")
Set xlsheet = xlsBook.Worksheets(2)
Set xlsheet1 = xlsBook.Worksheets(1)
 
XlsApp.Visible = False
 
For JJ = 1 To LgMax
 
xlsheet1.Cells(JJ, 1) = ""
xlsheet1.Cells(JJ, 2) = ""
xlsheet1.Cells(JJ, 3) = ""
 
Next JJ
 
For II = 1 To LgMax
 
xlsheet.Cells(II, 1) = ""
xlsheet.Cells(II, 2) = ""
xlsheet.Cells(II, 3) = ""
 
Next II
 
 
xlsBook.Save
xlsBook.Close
Excel.Application.Quit
Set xlsheet = Nothing
Set xlsBook = Nothing
Set XlsApp = Nothing
 
End Sub
 
Private Sub Form_Load()
'Initialisation des variables
II = 0
JJ = 0
Lg = 0
Lg1 = 1
Lg2 = 2
LgMax = 0
 
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
Set Form1 = Nothing
 
End Sub

1-Lance l’appli et commence par créer plusieurs enregistrements
2-Effectue tes transferts l’un après l’autre
3-Efface les données enregistré dans ton fichier Excel.

En espérant que cela t’aide au moins un petit peut

A+

merci BM42 pour cette prise de tête.

Jeme mets au boulot et je te tiens au courent

Salut

Le code est loin d'être top, mais il donne juste une ligne a suivre.
Attention j'ai fait une modif concernant l'énoncé (en rouge).

Bon courrage

A+

merci a toi bm42 pour le mal que tu t'est donné.
J'ai bien etudié ton code et je l'ai mis de coté pour une prochaine fois.
En fait je me suis compliqué la vie pour rien.
Apres un gros mal de tête voila le resultat :

declaration de ta variable lg en declaration :

Code:

lg as integer

initialisation de la variable dans form_load :

Code:

lg = 11

et pour terminer, le code pour le bouton:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub cmdok_Click() 'donne la valeur a la variable lg = lg + 1 'ecrit dans les cellules wsexcel.Cells(lg, 2) = Textdesign.Text wsexcel.Cells(lg, 3) = Textqte.Text wsexcel.Cells(lg, 4) = Textprix.Text 'vide les champs designation, etc... Textdesign.Text = "" Textqte.Text = "" Textprix.Text = "" End Sub
Tout ça c'est du fabrication maison donc pas dans les regles de l'art.

j'ai compris grace a bbill que je partais faux avec "xlup" et ton code m'a mis la puce a l'oreille avec les déclaration de JJ, LG, etc...

merci encore et a bientot

Re

Suite a MP de ProElect, que je remercie j'apporte une petit correction au code donné ci-dessus :

replacer

Code:

Public II, JJ, Lg, Lg1, Lg2, LgMax As Integer

par

Code:

Public II As Integer, JJ As Integer, Lg As Integer, Lg1 As Integer, Lg2 As Integer, LgMax As Integer

En se qui concerne le code comme je l'ais déjas dit il est loin d'être top mais il donne simplement une idée sur l'une des nombreuses possibilitées d'Excel

A+