Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

[VB]Problème ouverture de deux fichier excel


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    [VB]Problème ouverture de deux fichier excel
    Bonjour
    Je travaille sur un programme qui utilise deux fichiers Excel. Seulement j'ouvre le premier tout va bien et lorsque j'ouvre le deuxième il m'ouvre le même fichier que le deuxième.
    Je ne comprend pas pourquoi.
    voila mon code:
    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
     
    Dim appExcel As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel
    Dim wbExcelAna As Excel.Workbook 'Classeur Excel
    Dim wsExcelAna As Excel.Worksheet 'Feuille Excel
    Dim TestBoucle, No_Piece, DatePiece, Code_Journal, DateEche, Ref_Piece, CompteGen, MontantGen, Sens, Libelle, Code_Taxe, No_Plan, Type_Ecr, CompteTiers, MontantAna, SensAna, No_Plan_Ana, No_Section, Type_Ecr_Ana, NumPrim, Num_Ana As String
    Dim LigneGen, LigneAna As String
    Dim j, i As Integer
    Dim TestBool As Boolean
     
    Private Sub cmdValider_Click()
    Close
    j = 2
    i = 2
    'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
    'Ouverture d'un fichier Excel
    Set wbExcel = appExcel.Workbooks.Open(Form1.txtEcrGen)
    'wsExcel correspond à la première feuille du fichier
    Set wsExcel = wbExcel.Worksheets(1)
     
    'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
    'Ouverture d'un fichier Excel
    Set wbExcelAna = appExcel.Workbooks.Open(Form1.txtEcrAna)
    'wsExcel correspond à la première feuille du fichier
    Set wsExcelAna = wbExcel.Worksheets(1)
    Open Form1.txtDest For Output As #2
     
     
     
    While (wsExcel.Cells(i, 1).Value <> Empty)
        TestBool = False
        Num_Ana = "1"
        'LigneGen = "" & wsExcel.Cells(i, 2).Value & vbTab & "" & vbTab & wsExcel.Cells(i, 4).Value & vbTab & wsExcel.Cells(i, 5).Value & vbTab & wsExcel.Cells(i, 6).Value & vbTab & wsExcel.Cells(i, 7).Value & vbTab & wsExcel.Cells(i, 9).Value & vbTab & wsExcel.Cells(i, 22).Value & vbTab & wsExcel.Cells(i, 11).Value & vbtab &
        NumPrim = wsExcel.Cells(i, 1).Value
        No_Piece = wsExcel.Cells(i, 2).Value
        DatePiece = wsExcel.Cells(i, 4).Value
        Code_Journal = wsExcel.Cells(i, 5).Value
        Ref_Piece = wsExcel.Cells(i, 6).Value
        CompteGen = Mid(CStr(wsExcel.Cells(i, 7).Value), 1, 7)
        MontantGen = wsExcel.Cells(i, 9).Value
        Sens = wsExcel.Cells(i, 22).Value
        Libelle = wsExcel.Cells(i, 11).Value
     
        If Mid(CompteGen, 1, 3) = "401" Then
            Code_Taxe = "D19"
        ElseIf Mid(CompteGen, 1, 3) = "411" Then
            Code_Taxe = "C05"
        End If
     
        No_Plan = "0"
        Type_Ecr = "G"
        CompteTiers = wsExcel.Cells(i, 8).Value
        DateEche = wsExcel.Cells(i, 23).Value
     
        LigneGen = "" & No_Piece & vbTab & "" & vbTab & DatePiece & vbTab & Code_Journal & vbTab & Ref_Piece & vbTab & CompteGen & vbTab & MontantGen & vbTab & Sens & vbTab & Libelle & vbTab & Code_Taxe & vbTab & No_Plan & vbTab & Type_Ecr & vbTab & CompteTiers & vbTab & DateEche
        Print #2, LigneGen
     
        j = 2
        While (wsExcelAna.Cells(j, 1).Value <> Empty Or TestBool = True Or CDbl(Num_Ana) < CDbl(NumPrim))
            Num_Ana = wsExcelAna.Cells(j, 1).Value
            If wsExcelAna.Cells(j, 1).Value = NumPrim Then
     
     
                'Insertion Analytique
                MontantAna = wsExcelAna.Cells(j, 9).Value
     
                If wsExcelAna.Cells(j, 6).Value = "-1" Then
                    SensAna = "D"
                ElseIf wsExcelAna.Cells(j, 6).Value = "1" Then
                    SensAna = "C"
                End If
     
                No_Plan_Ana = "1"
                No_Section = wsExcelAna.Cells(j, 3).Value
                Type_Ecr_Ana = "A"
                LigneAna = "" & No_Piece & vbTab & "" & vbTab & DatePiece & vbTab & Code_Journal & vbTab & Ref_Piece & vbTab & CompteGen & vbTab & MontantAna & vbTab & SensAna & vbTab & Libelle & vbTab & Code_Taxe & vbTab & No_Plan_Ana & vbTab & No_Section & vbTab & Type_Ecr_Ana & vbTab & CompteTiers & vbTab & DateEche
                Print #2, LigneAna
     
                If wsExcelAna.Cells(j + 1, 1).Value = NumPrim Then
                    TestBool = True
                End If
            End If
     
            j = j + 1
        Wend
        i = i + 1
    Wend
    End Sub

    Merci

  2. #2
    Membre expérimenté
    Pourquoi ouvres-tu 2 fois l'application Excel, et en plus avec le même nom (AppExcel)?

  3. #3
    Membre du Club
    C'est vrai déja y avait ce problème et en plus je m'étais trompé dans une des déclarations.
    Mais ce problème est résolu mais j'en n'ai un autre.Dans ma boucle while mon test sur le booléen ne s'effectue pas.Revoila mon code
    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
     
    Dim appExcel As Excel.Application
    Dim appExcel1 As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel
    Dim wbExcelAna As Excel.Workbook 'Classeur Excel
    Dim wsExcelAna As Excel.Worksheet 'Feuille Excel
    Dim TestBoucle, No_Piece, DatePiece, Code_Journal, DateEche, Ref_Piece, CompteGen, MontantGen, Sens, Libelle, Code_Taxe, No_Plan, Type_Ecr, CompteTiers, MontantAna, SensAna, No_Plan_Ana, No_Section, Type_Ecr_Ana, NumPrim, Num_Ana As String
    Dim LigneGen, LigneAna As String
    Dim j, i As Integer
    Dim Num_AnaInt, NumPrimInt As Double
    Dim TestBool As Boolean
     
    Private Sub cmdValider_Click()
    Close
    j = 2
    i = 2
    'Ouverture de l'application
    Set appExcel = CreateObject("Excel.Application")
    'Ouverture d'un fichier Excel
    Set wbExcel = appExcel.Workbooks.Open(Form1.txtEcrGen)
    'wsExcel correspond à la première feuille du fichier
    Set wsExcel = wbExcel.Worksheets(1)
     
    'Ouverture de l'application
    Set appExcel1 = CreateObject("Excel.Application")
    'Ouverture d'un fichier Excel
    Set wbExcelAna = appExcel1.Workbooks.Open(Form1.txtEcrAna)
    'wsExcel correspond à la première feuille du fichier
    Set wsExcelAna = wbExcelAna.Worksheets(1)
    Open Form1.txtDest For Output As #2
     
     
     
    While (wsExcel.Cells(i, 1).Value <> Empty)
        TestBool = False
        Num_Ana = "1"
        'LigneGen = "" & wsExcel.Cells(i, 2).Value & vbTab & "" & vbTab & wsExcel.Cells(i, 4).Value & vbTab & wsExcel.Cells(i, 5).Value & vbTab & wsExcel.Cells(i, 6).Value & vbTab & wsExcel.Cells(i, 7).Value & vbTab & wsExcel.Cells(i, 9).Value & vbTab & wsExcel.Cells(i, 22).Value & vbTab & wsExcel.Cells(i, 11).Value & vbtab &
        NumPrim = wsExcel.Cells(i, 1).Value
        No_Piece = wsExcel.Cells(i, 2).Value
        DatePiece = wsExcel.Cells(i, 4).Value
        Code_Journal = wsExcel.Cells(i, 5).Value
        Ref_Piece = wsExcel.Cells(i, 6).Value
        CompteGen = Mid(CStr(wsExcel.Cells(i, 7).Value), 1, 7)
        MontantGen = wsExcel.Cells(i, 9).Value
        Sens = wsExcel.Cells(i, 22).Value
        Libelle = wsExcel.Cells(i, 11).Value
     
        If Mid(CompteGen, 1, 3) = "401" Then
            Code_Taxe = "D19"
        ElseIf Mid(CompteGen, 1, 3) = "411" Then
            Code_Taxe = "C05"
        End If
     
        No_Plan = "0"
        Type_Ecr = "G"
        CompteTiers = wsExcel.Cells(i, 8).Value
        DateEche = wsExcel.Cells(i, 23).Value
     
        LigneGen = "" & No_Piece & vbTab & "" & vbTab & DatePiece & vbTab & Code_Journal & vbTab & Ref_Piece & vbTab & CompteGen & vbTab & MontantGen & vbTab & Sens & vbTab & Libelle & vbTab & Code_Taxe & vbTab & No_Plan & vbTab & Type_Ecr & vbTab & CompteTiers & vbTab & DateEche
        Print #2, LigneGen
     
        j = 2
        While ((wsExcelAna.Cells(j, 1).Value <> Empty) Or (TestBool = True))
            Num_Ana = wsExcelAna.Cells(j, 1).Value
            If wsExcelAna.Cells(j, 1).Value = NumPrim Then
                'Insertion Analytique
                MontantAna = wsExcelAna.Cells(j, 9).Value
     
                If wsExcelAna.Cells(j, 6).Value = "-1" Then
                    SensAna = "D"
                ElseIf wsExcelAna.Cells(j, 6).Value = "1" Then
                    SensAna = "C"
                End If
     
                No_Plan_Ana = "1"
                No_Section = wsExcelAna.Cells(j, 3).Value
                Type_Ecr_Ana = "A"
                LigneAna = "" & No_Piece & vbTab & "" & vbTab & DatePiece & vbTab & Code_Journal & vbTab & Ref_Piece & vbTab & CompteGen & vbTab & MontantAna & vbTab & SensAna & vbTab & Libelle & vbTab & Code_Taxe & vbTab & No_Plan_Ana & vbTab & No_Section & vbTab & Type_Ecr_Ana & vbTab & CompteTiers & vbTab & DateEche
                Print #2, LigneAna
     
                If wsExcelAna.Cells(j + 1, 1).Value = NumPrim Then
                    TestBool = True
                End If
            End If
            Num_AnaInt = CDbl(Num_Ana)
            NumPrimInt = CDbl(NumPrim)
            If Num_AnaInt > NumPrimInt Then
                TestBool = False
            End If
            j = j + 1
        Wend
        i = i + 1
    Wend
    End Sub

    Merci

  4. #4
    Membre expérimenté
    Remplace ton test par celui la:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    While Not IsEmpty(wsExcel.Cells(i, 1)) ...

###raw>template_hook.ano_emploi###