Bonjour à tous,

J'aimerais avoir une aide pour optimiser une select case, pour ne pas avoir à répéter deux fois l'ouverture de même fichier pour écriture.

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
'---------------------------------------------------------
Option Explicit
 
Sub OuvreFich()
    Dim B$(), BB$(), Arr()
    Dim Reponse As Variant, Canal As Variant
    Dim Item
    Dim fName As String, A$
    Dim i As Byte, j As Byte, LastLg As Long, X As Long
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    'On Error Resume Next
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = False Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
 
    'Tableau des XAC
    Arr = Array("12", "15", "70", "33", "62")
    fName = "TPC "    ' Nom du fichier sous la forme : "TPC*.xls"
    Do While Not EOF(Canal)
        Line Input #Canal, A$
 
        If Len(Trim(A$)) > 0 Then    '-- Si la ligne est non vide
 
            If InStr(1, A$, "XAC") > 0 Then
                Line Input #Canal, A$
                X = 0
                Do While InStr(1, A$, "END") = 0
                    i = 0: j = 0
                    If Arr(X) = Mid(Trim(A$), 1, 2) Then
                        B$ = Split(Trim(A$), " ")
                        '-- Eliminer les vides du tableau B$
                        For Each Item In B$
                            If Len(Item) > 0 Then
                                ReDim Preserve BB$(j)
                                BB$(j) = B$(i)
                                j = j + 1
                            End If
                            i = i + 1
                        Next Item
                        Select Case Arr(X)
                        Case "12"
                            'ouvre PA
                            Workbooks.Open fName & "PA.xls"
                            '*-- 12 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
                        Case "15"
                            'ouvre PA
                            Workbooks.Open fName & "PA.xls"
                            '-- 15 --
                            [E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)
                        Case "70"
                            'ouvre JCW
                            Workbooks.Open fName & "JCB.xls"
                            '-- 70 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
                        Case "33"
                            'ouvre MSK
                            Workbooks.Open fName & "MSK.xls"
                            '*-- 33 --
                            [E22] = [F22]: [F22] = BB$(2): [G22] = [H22]: [H22] = BB$(3)
 
                        Case "62"
                            'ouvre MSK
                            Workbooks.Open fName & "MSK.xls"
                            '-- 62 --
                            [E25] = [F25]: [F25] = BB$(2): [G25] = [H25]: [H25] = BB$(3)
 
                        End Select
                    End If
                    Line Input #Canal, A$
                    X = X + 1
                Loop
            End If
        End If
    Loop
    On Error GoTo 0
End Sub
'------------------------------------------
Merci d'avance.