Discussion :

[monopole]

bonjour,
sur un ptit programme d extraction , j aimerai bien savoir comment pui-je reduire le code de mon appli conçernant la commande loop :

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
 
Public Sub WriteExcelStat2()
If oExcelApp Is Nothing Then Exit Sub
    Dim oExcelSheet_k1 As Excel.Worksheet
    Set oExcelSheet_k1 = oExcelDoc.Worksheets("K1")
    Dim oExcelSheet_k2 As Excel.Worksheet
    Set oExcelSheet_k2 = oExcelDoc.Worksheets("K2")
    Dim oExcelSheet_k3 As Excel.Worksheet
    Set oExcelSheet_k3 = oExcelDoc.Worksheets("K3")
    Dim oExcelSheet_k4 As Excel.Worksheet
 
    Dim vcon As New ADODB.Connection
    Dim vrs As New ADODB.Recordset
    vrs.CursorType = 3
    vcon.Open vNPAIConnectionString
    vcon.CommandTimeout = 1200
 
 '---------------------------------------------------------------------------------K1
 req = "select fiche_resiliation.* from fiche_resiliation where " & _
          " fic_date_modif >= '" & txtdatedebut.Text & "' and " & _
          " fic_date_modif <= '" & txtdatefin.Text & "' and fic_k='K1' and fic_etat <> '' "
    vrs.Open req, vcon
i = 4
     Do While Not vrs.EOF
    oExcelSheet_k1.Cells(i, 1).Value = vrs("fic_contrat")
    oExcelSheet_k1.Cells(i, 2).Value = vrs("fic_scs")
    oExcelSheet_k1.Cells(i, 3).Value = vrs("fic_resp")
    oExcelSheet_k1.Cells(i, 4).Value = vrs("fic_elig")
    oExcelSheet_k1.Cells(i, 5).Value = vrs("fic_enre")
    oExcelSheet_k1.Cells(i, 6).Value = vrs("fic_conf")
    oExcelSheet_k1.Cells(i, 7).Value = vrs("fic_prog")
    oExcelSheet_k1.Cells(i, 8).Value = vrs("fic_trai")
    oExcelSheet_k1.Cells(i, 9).Value = vrs("fic_etat")
     i = i + 1
    vrs.MoveNext
     Loop
    vrs.close
'---------------------------------------------------------------------------------K2
 req = "select fiche_resiliation.* from fiche_resiliation where " & _
          " fic_date_modif >= '" & txtdatedebut.Text & "' and " & _
          " fic_date_modif <= '" & txtdatefin.Text & "' and fic_k='K2' and fic_etat <> '' "
    vrs.Open req, vcon
i = 4
     Do While Not vrs.EOF
    oExcelSheet_k2.Cells(i, 1).Value = vrs("fic_contrat")
    oExcelSheet_k2.Cells(i, 2).Value = vrs("fic_scs")
    oExcelSheet_k2.Cells(i, 3).Value = vrs("fic_resp")
    oExcelSheet_k2.Cells(i, 4).Value = vrs("fic_elig")
    oExcelSheet_k2.Cells(i, 5).Value = vrs("fic_enre")
    oExcelSheet_k2.Cells(i, 6).Value = vrs("fic_conf")
    oExcelSheet_k2.Cells(i, 7).Value = vrs("fic_prog")
    oExcelSheet_k2.Cells(i, 8).Value = vrs("fic_trai")
    oExcelSheet_k2.Cells(i, 9).Value = vrs("fic_etat")
     i = i + 1
    vrs.MoveNext
     Loop
    vrs.close
'---------------------------------------------------------------------------------K3
 req = "select fiche_resiliation.* from fiche_resiliation where " & _
          " fic_date_modif >= '" & txtdatedebut.Text & "' and " & _
          " fic_date_modif <= '" & txtdatefin.Text & "' and fic_k='K3' and fic_etat <> '' "
    vrs.Open req, vcon
i = 4
     Do While Not vrs.EOF
    oExcelSheet_k3.Cells(i, 1).Value = vrs("fic_contrat")
    oExcelSheet_k3.Cells(i, 2).Value = vrs("fic_scs")
    oExcelSheet_k3.Cells(i, 3).Value = vrs("fic_resp")
    oExcelSheet_k3.Cells(i, 4).Value = vrs("fic_elig")
    oExcelSheet_k3.Cells(i, 5).Value = vrs("fic_enre")
    oExcelSheet_k3.Cells(i, 6).Value = vrs("fic_conf")
    oExcelSheet_k3.Cells(i, 7).Value = vrs("fic_prog")
    oExcelSheet_k3.Cells(i, 8).Value = vrs("fic_trai")
    oExcelSheet_k3.Cells(i, 9).Value = vrs("fic_etat")
     i = i + 1
    vrs.MoveNext
     Loop
    vrs.close
..................etc

je voudrai savoir s il y a la possibilité d inclementé le k1 k2 et k3 pour mettre un seul code au lieu de reppeté le tous a chaque modif des k
merci

[Delbeke]

Essaye de t'inspirer de ce bout de code

Code :

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

1
2
3
4
5
6
7
 
  Dim oExcelSheet As Excel.Worksheet
  Dim lSheet As Long
  For lSheet = 1 To oExcelDoc.Worksheets.Count
    Set oExcelSheet = oExcelDoc.Worksheets("K" & CStr(lSheet))
    ....
  Next