Sujet Précédent Sujet Suivant

Exécution d'un traitement en VBA sur fichier Excel + autre fichier Excel ouvert

Résolu
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009 - 10 déc. 2009 à 14:05
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009 - 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-

7 réponses

Réponse 1 / 7
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
10 déc. 2009 à 16:09
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+
3
Réponse 2 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
10 déc. 2009 à 14:37
Bonjour,

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


____________________
Très intéressante fable, L'OISELEUR, L'AUTOUR ET L'ALOUETTE !
0
Réponse 3 / 7
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009
10 déc. 2009 à 14:45
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-
0
Réponse 4 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
10 déc. 2009 à 14:52
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 !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009
10 déc. 2009 à 15:06
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
0
Réponse 6 / 7
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009
10 déc. 2009 à 16:12
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
0
Réponse 7 / 7
Gunshin82 Messages postés 37 Date d'inscription jeudi 22 mars 2007 Statut Membre Dernière intervention 10 décembre 2009
10 déc. 2009 à 16:15
Ca fonctionne nickel Thank you! Thank you! Thank you!


[b]Most people would die sooner than think; in fact, they do.
-Bertrand Russell-/b
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Modulo pour chiffres à virgule
cs_ebro -
Gally -

8 réponses
Rejoignez-nous