Exécution d'un traitement en VBA sur fichier Excel + autre fichier Excel ouvert [Résolu]

Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention - 10 déc. 2009 à 14:05 - Dernière réponse : Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention
- 10 déc. 2009 à 16:15
Bonjour à tous,

J'ai un p'tit problème en VBA. J'ai développer un traitement lancer à partir d'un menu, dans une base Access. Ce traitement, il met en forme un fichier Excel pour ensuite l'importer dans la base.

Mon soucis est le suivant : Si j'ai le malheur d'ouvrir un deuxième fichier Excel lorsque le traitement tourne, ça fait planté mon process...

Dans mon code, tout les références fait au cellules, feuilles et workbook sont tous nominatif envers le workbook sur lequel le traitement tourne, example :

...
With Workbooks(File)
    'Ajouter deux feuilles nommer Bla1 et Bla2
    Set NouvFeuil = .Worksheets.Add
    NouvFeuil.Name = "Bla1"
    Set NouvFeuil = .Worksheets.Add
    NouvFeuil.Name = "Bla2"
        
    With .Worksheets("Feuil1")
        L_Row = .Cells.SpecialCells(xlLastCell).Row
        
        For x = 1 To L_Row
            If .Range("A" & x).Value Like "*Bla1*" Then
                .Range("J" & x).Value = "OTHER"
                x = x + 1
                While .Range("A" & x).Value <> "Total service" And Not (.Range("A" & x).Value Like "*Sous total service*")
                    If (IsEmpty(.Range("B" & x).Value) = False) Or .Range("B" & x).Value <> "" Then
                        .Range("J" & x).Value = "Bla1"
                    Else
                        .Range("J" & x).Value = "OTHER"
                    End If
                        x = x + 1
                Wend
                .Range("J" & x).Value = "OTHER"
            ElseIf .Range("A" & x).Value Like "*Bla2*" Then
                ...
            End If
        Next
        ...
    End With
    ...
End With
...


Comment dois-je procéder pour pouvoir manipuler d'autre fichier Excel lorsque le traitement tourne?

Merci,
G82

Most people would die sooner than think; in fact, they do.
-Bertrand Russell-
Afficher la suite 

Votre réponse

7 réponses

Meilleure réponse
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 déc. 2009 à 16:09
3
Merci
Salut,

la meilleur solution est de privatiser la session excel que tu as ouverte. Ceci pour interdire tout autre ouverture de fichier pendant le fonctionnement de ta macro.

A mettre en debut de macro

Application.IgnoreRemoteRequests = True


avec ceci si l'utilisateur ouvre un fichier excel, ce dernier sera systematiquement ouvert dans une nouvelle session



A+

Merci bigfish_le vrai 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 96 internautes ce mois-ci

Commenter la réponse de bigfish_le vrai
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 10 déc. 2009 à 14:37
0
Merci
Bonjour,

dans quel évènement as-tu mis ce code ?


____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !
Commenter la réponse de ucfoutu
Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention - 10 déc. 2009 à 14:45
0
Merci
Derrière un bouton, dans un Menu, dans une base Access. Pourriez-vous me dire la relation avec le fait que je ne peux utilisé Excel lorsque le traitement tourne, sans le faire planté ? Car je ne comprend pas ce que l'évènement a à faire avec cela...

Merci,
G82

Most people would die sooner than think; in fact, they do.
-Bertrand Russell-
Commenter la réponse de Gunshin82
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 10 déc. 2009 à 14:52
0
Merci
Montre-nous tout le code (y compris la ligne sub.... et jusqu'à la ligne End Sub) mis pour l'évènement Click du bouton que tu cliques sous Access.

____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !
Commenter la réponse de ucfoutu
Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention - 10 déc. 2009 à 15:06
0
Merci
Voici :

Private Sub TRAITEMENT_123_456_Click()

    'Développeur : 
    'Date : 11/04/2007
    'Description : Ce code va flagger et séparrer les établissements 123 et 456 du même fichier.
    'Màj : 10/12/2009
    '   °Modification de la méthode pour récupérer le fichierProcédure;
    '   °Mise à jour du code pour éviter les sauts (GoTo);
    '   °Rendre les fonctions utiliser sur le fichier Excel nominatif pour permettre l'utilisation
    '       de d'autre fichier Excel lors du traitement;
    '   °Intégration d'une vérification pour savoir s'il y a des données pour chacun des établissements
    '       avec l 'option de continué ou arrêter pour visualiser le fichier;
    '   °Optimissation du processuce de créer et renommer de nouvel feuille, pour éviter les erreurs si
    '       Feuil2 ou 3 n'existe pas.
    'Logiciel d'exécution : EXCEL
    
    'Vérifie si la période est bien renseigner
    If IsNull(PERIODE) Or PERIODE = "" Then
        MsgBox "Veuillez renseigner la periode du traitement.", vbOKOnly, "Periode Non Renseigner!!"
        Exit Sub
    End If
    
    DoCmd.Hourglass True
    
    'Déclarer les variables
    Dim Ch_Orig, Ch_ETAB_1, Ch_ETAB_2, File As String
    Dim L_Row, Found_Row, Check_Row As Integer
    Dim TRAIT2 As Access.Application
    
    'Assigner le chemin du fichier à la variable Ch_Orig
    Ch_Orig = "\\serveur1\dossier1" & PERIODE & "\123"
    
    'Assigner le chemin et le nom des deux fichiers final
    Ch_ETAB_1 = "\\serveur1\dossier1" & PERIODE & "\123\123_456_BridgeII.xls"
    Ch_ETAB_2 = "\\serveur1\dossier1" & PERIODE & "\456\123_456_BridgeII.xls"
    
    'Aller chercher le fichier à traiter
    File = Dir(Ch_Orig)

'************************************Màj 10/12/2009************************************
    While Right(File, 4) <> ".xls" Or File = "123_456_BridgeII.xls"
        File = Dir
        'Si aucun fichier n'est trouver
        If File = "" Then
            MsgBox "Aucun fichier Excel trouver, veuillez vérifier le dossier du 123", vbCritical, "Avertissement"
            Exit Sub
        End If
    Wend
    Workbooks.Open (Ch_Orig & File) '.Application.Visible = True
    
    With Workbooks(File)
        'Ajouter deux feuilles nommer ETAB_1 et ETAB_2
        Set NouvFeuil = .Worksheets.Add
        NouvFeuil.Name = "ETAB_1"
        Set NouvFeuil = .Worksheets.Add
        NouvFeuil.Name = "ETAB_2"
        
        With .Worksheets("Feuil1")
            L_Row = .Cells.SpecialCells(xlLastCell).Row
        
            For x = 1 To L_Row
                If .Range("A" & x).Value Like "*ETAB_1*" Then
                    .Range("J" & x).Value = "OTHER"
                    x = x + 1
                    While .Range("A" & x).Value <> "Total service" And Not (.Range("A" & x).Value Like "*Sous total service*")
                        If (IsEmpty(.Range("B" & x).Value) = False) Or .Range("B" & x).Value <> "" Then
                            .Range("J" & x).Value = "ETAB_1"
                        Else
                            .Range("J" & x).Value = "OTHER"
                        End If
                        x = x + 1
                    Wend
                    .Range("J" & x).Value = "OTHER"
                ElseIf .Range("A" & x).Value Like "*ETAB_2*" Then
                    .Range("J" & x).Value = "OTHER"
                    x = x + 1
                    While .Range("A" & x).Value <> "Total service" And Not (.Range("A" & x).Value Like "*Sous total service*")
                        If (IsEmpty(.Range("B" & x).Value) = False) Or .Range("B" & x).Value <> "" Then
                            .Range("J" & x).Value = "ETAB_2"
                        Else
                            .Range("J" & x).Value = "OTHER"
                        End If
                        x = x + 1
                    Wend
                    .Range("J" & x).Value = "OTHER"
                ElseIf .Range("A" & x).Value Like "*Libell*" Then
                    .Range("J" & x).Value = "ENTETE"
                Else
                    .Range("J" & x).Value = "OTHER"
                End If
            Next
            'Trouver la ligne d'entête
            Found_Row = .Cells.Find("ENTETE", LookIn:=xlValues).Row
            
            'Coller les données ETAB_1 situer dans la Feuil1 dans ETAB_1
            .Range("J" & Found_Row, "J" & L_Row).AutoFilter Field:=1, Criteria1:="ETAB_1"
            Check_Row = .Cells.SpecialCells(xlLastCell).Row
            If Check_Row = Found_Row Then
                If MsgBox("Aucune donnée pour le paneliste ETAB_1 (123). Ceci peut être dû à une erreur," & Chr(13) & "souhaitez-vous continuer?", vbYesNo, "Avertissement!") = vbNo Then
                    .Activate
                    .Range("A1").Activate
                    .Application.Visible = True
                    Exit Sub
                End If
            End If
            .Range("A" & Found_Row, "H" & L_Row).Copy
        End With
        .Worksheets("ETAB_1").Range("A1").PasteSpecial
        
        'Coller les données ETAB_2 situer dans la Feuil1 dans ETAB_2
        With .Worksheets("Feuil1")
            .Range("J" & Found_Row, "J" & L_Row).AutoFilter Field:=1, Criteria1:="ETAB_2"
            Check_Row = .Cells.SpecialCells(xlLastCell).Row
            If Check_Row = Found_Row Then
                If MsgBox("Aucune donnée pour le paneliste ETAB_2 (456). Ceci peut être dû à une erreur," & Chr(13) & "souhaitez-vous continuer?", vbYesNo, "Avertissement!") = vbNo Then
                    .Activate
                    .Range("A1").Activate
                    .Application.Visible = True
                    Exit Sub
                End If
            End If
            .Range("A" & Found_Row, "H" & L_Row).Copy
        End With
        .Worksheets("ETAB_2").Range("A1").PasteSpecial
    End With
'**************************************************************************************
    
    'Sauvegarder le fichier dans les répertoires du 123 et du 456
    Excel.Application.DisplayAlerts = False
    Workbooks(File).SaveAs Ch_ETAB_1
    On Error Resume Next
    MkDir "\\serveur1\dossier1" & PERIODE & "\456"
    On Error GoTo 0
    Workbooks("123_456_BridgeII.xls").SaveAs Ch_ETAB_2
    
    'Fermer le Fichier
    Workbooks("123_456_BridgeII.xls").Close
    'Quitter Excel s'il n'y a plus de fichier d'ouvert
    If Excel.Application.Workbooks.Count < 1 Then
        Excel.Application.Quit
    End If
    
    DoCmd.Hourglass False
    
    'Avertir l'utilisateur que le traitement est terminé
    MsgBox "Traitement terminé!!! N'oubliez pas de marquer et de charger le 456!!!", vbExclamation, "Terminer"
    
    'Ouvrir TRAIT2.mdb
    Set TRAIT2 = CreateObject("Access.Application")
    With TRAIT2
        .OpenCurrentDatabase "\\serveur2\DATABASES\dossier0\dossier1\trait\TRAIT2.MDB", True
        .Forms("Interface")!ID = 123
        .Forms("Interface")!numfic = 1
        .Forms("Interface")!PERIODE = Format(DateAdd("m", -1, Date), "mmyy")
        .Forms("Interface")!PERIODE_REF = Format(DateAdd("m", -2, Date), "mmyy")
        .Forms("Interface").Refresh
    End With
    
End Sub
Commenter la réponse de Gunshin82
Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention - 10 déc. 2009 à 16:12
0
Merci
Parfait, c'est exactement ce que je cherchais !! Merci beaucoup , je vais tester de suite.


[b]Most people would die sooner than think; in fact, they do.
-Bertrand Russell-/b
Commenter la réponse de Gunshin82
Gunshin82 37 Messages postés jeudi 22 mars 2007Date d'inscription 10 décembre 2009 Dernière intervention - 10 déc. 2009 à 16:15
0
Merci
Ca fonctionne nickel Thank you! Thank you! Thank you!


[b]Most people would die sooner than think; in fact, they do.
-Bertrand Russell-/b
Commenter la réponse de Gunshin82

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.