Grosse Macro ne fonctionne plus

Grosse Macro ne fonctionne plus - VB/VBA/VBS - Programmation

Marsh Posté le 10-05-2007 à 16:14:44    

Bonjour,  
J'ai besoin d 'aide svp pour résoudre un problème sur une macro qui auparavant marche et aujourd'hui elle ne fonctionne plus. Personne n'a touché au code, la seule chose qui a changée est l'environnement du travail. En fait c'est une macro que j'ai utilisé dans mon ancien boulot et aujourd'hui je change donc je l'apporte avec moi, mais !!!!
J'explique le fonctionnement de la macro: elle ouvre un ensemble de fichiers à partir d'un repertoire, applique un certains nombre de modifications, et ensuite elle ferment tout en enregistrant soit dans le même endroit soit ailleurs. voila le code de la macro. si quelqu'un peux m'aider svp ca sera cool,  
 
'Paramètre
Dim chemin_source As String
Dim chemin_cible As String
Dim classeur As Object
Dim fonction As Variant
Dim indice As Integer
Dim fs, f, fc, f_crt As Variant
 
 
Sub traitement()
     
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
     
    'parcour la liste des zones de saisie des répertoires
    For indice = 1 To 45
                 
        'Mise à jour des liens
        If UCase(Trim(Range("A4" ))) = "VRAI" Then
            If UCase(Trim(Cells(8 + indice, 1))) = "VRAI" Then
                chemin_source = Cells(8 + indice, 3)
                If chemin_source <> "" Then
                    parcourir_repertoire
                ElseIf chemin_source = "" Then
                    Cells(8 + indice, 3).Value = "non renseigné => traitement impossible"
                End If
            End If
             
        'Autre que mise à jour des liens
        Else
            If UCase(Trim(Cells(8 + indice, 1))) = "VRAI" Then
                chemin_cible = Cells(8 + indice + 1, 3)
                chemin_source = Cells(8 + indice, 3)
                If chemin_source <> "" And chemin_cible <> "" Then
                   parcourir_repertoire
                Else
                   If chemin_source = "" Then Cells(8 + indice, 3).Value = "non renseigné => traitement impossible"
                   If chemin_cible = "" Then Cells(8 + indice + 1, 3).Value = "non renseigné => traitement impossible"
                End If
             End If
        End If
    Next
    MsgBox ("Traitement terminé" )
     
End Sub
------------------------------------------------------------------------------------------------------------
Sub parcourir_repertoire()
     
 Set fs = CreateObject("Scripting.FileSystemObject" )
    Set f = fs.GetFolder(chemin_source)
    Set fc = f.Files
         
    'pour chaque fichier du répertoire, on applique les procédures ci-dessous
    For Each f_crt In fc
        'filtre uniquement les fichiers excel
        If f_crt.Type = "Microsoft Excel Worksheet" Then
            ouverture_fichier
           ' mise_en_forme
            fermeture_fichier
        End If
    Next
 
End Sub
------------------------------------------------------------------------------------------------------------
Sub ouverture_fichier()
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
 
    'updatelinks = 0 pas de mise à jour des liens
    'updatelinks = 3 mise à jour des liens
 
 If UCase(Trim(Range("A4" ))) = "VRAI" Then
    Workbooks.Open f_crt, UpdateLinks:=3
    Set classeur = ActiveWorkbook
Else
    Workbooks.Open f_crt, UpdateLinks:=3
    ActiveWorkbook.SaveAs chemin_cible & "\" & ActiveWorkbook.Name
    Set classeur = ActiveWorkbook
End If
 
End Sub
------------------------------------------------------------------------------------------------------------
Sub fermeture_fichier()
         
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
         
    classeur.Worksheets(1).Activate
    classeur.Save
    classeur.Saved = True
    classeur.Close
 
End Sub
------------------------------------------------------------------------------------------------------------
Sub mise_en_forme()
 
    Dim i As Integer
    Dim liaisons As Variant
     
             
    ThisWorkbook.Worksheets(1).Activate
     
'Mise à jour des liens
    If UCase(Trim(Range("A4" ))) = "VRAI" Then
     
        'Il n'y a pas de mise en forme
        'la mise jour des liens est effectuée à l'ouverture des classeurs
 
'Suppression des liens
    ElseIf UCase(Trim(Range("A5" ))) = "VRAI" Then
             
            'Détermine les liens de type Excel dans un tableau
            classeur.Activate
            liaisons = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
             
            'Pour chaque liens du tableau, casser la liaison
             'If Not IsEmpty(liaison) Then
             If IsEmpty(liaisons) Then
                'rien
             Else
                For i = 1 To UBound(liaisons)
                    ActiveWorkbook.BreakLink _
                                Name:=liaisons(i), _
                                Type:=xlLinkTypeExcelLinks
                Next
            End If
 
'Suppression des liens et formules
    ElseIf UCase(Trim(Range("A6" ))) = "VRAI" Then
     
        For i = 1 To Worksheets.Count
            classeur.Worksheets(i).Activate
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlValues
            Cells(1, 1).Select
        Next
     
    End If
     
End Sub
 
 
Merci bcp pour votre aide.

Reply

Marsh Posté le 10-05-2007 à 16:14:44   

Reply

Marsh Posté le 10-05-2007 à 16:59:29    

ca te jette à quel endroit ?
as-tu vérifié les références sur ta nouvelle machine ?

Reply

Marsh Posté le 10-05-2007 à 17:08:29    

Que veux tu dire par les réferences ??, je ne suis pas un prof de la programmation.
Le problème c'est qu'elle fait semblant de bien tourner jusqu'à l'affichage du message  ("Traitement terminé" ) sans pourtant mettre à jour le fichier ou le livrer à l'endroit précis.

Reply

Marsh Posté le 10-05-2007 à 17:11:40    

Si j'essai d'executer la macro  ouverture_fichier ca bloque à ce niveau :    Workbooks.Open f_crt, UpdateLinks:=3
 
Merci

Reply

Marsh Posté le 10-05-2007 à 17:12:57    

passe ton élément f_crt en parametre dans ta fonction, c'est pas propre sinon

Reply

Marsh Posté le 10-05-2007 à 17:15:26    

Il y est déja sous cette forme.Mais ca toujours fonctionné comme ca. je présice que personne n'a touché au code.

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed