Appel de macro mystérieux ??

Le 07/04/2014 à 21:52

Bonjour,

J'ai un petit bout de macro dans une feuille, la feuille103.

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("k9") <> 0 Then
    MsgBox "Je crée le fichier de l'année prochaine."
Call Créer_fichier_nouvelle_année
End If
End Sub

If Worksheets(103).Range("k9") <> 0 Then

MsgBox "Je crée le fichier de l'année prochaine."

Call Créer_fichier_nouvelle_année

End If

End Sub[/code]

Voici le code de la macro Créer.... ainsi que toutes les procédures nécessaires, elles sont dans le même module.

Sub Créer_fichier_nouvelle_année()

Dim an As String, chemin As String
Dim Excel_App As Excel.Application

an = Year(Date)

chemin = "C:\Opr\Claire\Relevé quotidien\RELEVÉ QUOTIDIEN "

Effacer_fichier

ActiveWorkbook.SaveAs (chemin & an & "-" & an + 1 & ".xlsm")

Application.DisplayAlerts = False

Enlever_la_protection

    ActiveWorkbook.ChangeLink _
        chemin & an - 2 & "-" & an - 1 & ".xlsm", _
        chemin & an - 1 & "-" & an & ".xlsm", xlExcelLinks

ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

Effacer_R
Effacer_V

aa = Application.InputBox("Format de la date ex.: 25/01/2015", "Date du samedi de la période 1-1", Type:=1)
Worksheets("1-1R").Activate
Range("J1").Value = aa

Calculate
Protéger_feuille

ActiveWorkbook.Save
Worksheets("Vérification").Activate
ActiveSheet.Unprotect

Range("L1").Value = "Relevé quotidien " & an & "-" & an + 1

ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
Range("a1").Value = "Relevé quotidien " & an - 1 & "-" & an
ActiveWorkbook.ChangeLink _
        chemin & an - 2 & "-" & an - 1 & ".xlsm", chemin & an - 1 & "-" & an & ".xlsm", xlExcelLinks

ComparePlages
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

Private Sub Effacer_fichier()
    Dim Pat As String, Fichier As String

    Pat = "C:\Opr\Claire\Relevé quotidien\"

    Fichier = "RELEVÉ QUOTIDIEN 2014-2015.xlsm"

    If Dir(Pat & Fichier) <> "" Then   'le fichier existe déjà

        Kill Pat & Fichier
    Else
        Exit Sub

    End If

End Sub

Private Sub ComparePlages()  'Jean-Eric

Dim Arr1, _
    Arr2, _
    Flag As Boolean, _
    i As Long, j As Long, _
    cpt As Long, x As Integer

    Cells.Interior.Color = xlNone
    Application.ScreenUpdating = False
    Arr1 = Range("A2:J54").Value
    Arr2 = Range("L2:U54").Value
    Flag = True

    For i = LBound(Arr1, 2) To UBound(Arr1, 2)
        For j = LBound(Arr1, 1) To UBound(Arr1, 1)
            Debug.Print Cells(j + 1, i).Address & "-" & Cells(j + 1, i + 11).Address
            If Not CCur(Arr1(j, i)) = CCur(Arr2(j, i)) Then
                Flag = False
                Cells(j + 1, i).Interior.Color = RGB(255, 204, 0)
                Cells(j + 1, i + 11).Interior.Color = RGB(255, 204, 0)
                cpt = cpt + 1
            End If

        Next j
    Next i

    If cpt > 0 Then
        MsgBox "Vous avez " & cpt & " anomalies(s)." _
            & Chr(10) & "Les cellules sont mises en évidence." & Chr(10) & "Corriger les données sur les feuilles des périodes identifiés dans la colonne K.", 16
    Else
        MsgBox "Les 2 plages sont identiques.Le fichier va fermer,", 64
    Choisir_Toutes_les_feuilles
    Sheets(1).Select

    End If

End Sub

Private Sub Choisir_Toutes_les_feuilles()
Sheets(Array("1-1R", "1-2R", "1-3R", "1-4R", "2-1R", "2-2R", "2-3R", "2-4R", "3-1R", _
        "3-2R", "3-3R", "3-4R", "4-1R", "4-2R", "4-3R", "4-4R", "5-1R", "5-2R", "5-3R", "5-4R", _
        "6-1R", "6-2R", "6-3R", "6-4R", "7-1R", "7-2R", "7-3R", "7-4R", "8-1R", "8-2R", "8-3R", "8-4R", "9-1R", "9-2R", _
        "9-3R", "9-4R", "10-1R", "10-2R", "10-3R", "10-4R", "11-1R", "11-2R", "11-3R", "11-4R", _
        "12-1R", "12-2R", "12-3R", "12-4R", "13-1R", "13-2R", "13-3R", "13-4R", "13-5R", "1-1V", "1-2V", "1-3V", "1-4V", "2-1V", "2-2V", "2-3V", "2-4V", "3-1V", _
        "3-2V", "3-3V", "3-4V", "4-1V", "4-2V", "4-3V", "4-4V", "5-1V", "5-2V", "5-3V", "5-4V", _
        "6-1V", "6-2V", "6-3V", "6-4V", "7-1V", "7-2V", "7-3V", "7-4V", "8-1V", "8-2V", "8-3V", "8-4V", "9-1V", "9-2V", _
        "9-3V", "9-4V", "10-1V", "10-2V", "10-3V", "10-4V", "11-1V", "11-2V", "11-3V", "11-4V", _
        "12-1V", "12-2V", "12-3V", "12-4V", "13-1V", "13-2V", "13-3V", "13-4V", "13-5V")).Select

Range("a1").Select
End Sub

Private Sub Effacer_R()
'
' Effacer_R Macro
' Macro enregistrée le 2006/07/18 par Claire
    Choisir_R
    Range("C4:J10,C30:D30,C32:D32,C34:D35,F30:G35,I30:J35,B40:I40,B45:I45").Select
    Selection.ClearContents
End Sub

Private Sub Effacer_V()
'
' Effacer_V Macro
' Macro enregistrée le 2006/07/18 par Claire
    Choisir_V
    Range("B5:C8,G5:J8,B12:C15,G12:J15,B18:C22,B26:C29,h20:n33,B33:C36,f42:l42,c9,c16,c23,c30,c37,i9,i16,O20:O33").Select
    Selection.ClearContents
End Sub
Private Sub Choisir_R()

    Sheets(Array("1-1R", "1-2R", "1-3R", "1-4R", "2-1R", "2-2R", "2-3R", "2-4R", "3-1R", _
            "3-2R", "3-3R", "3-4R", "4-1R", "4-2R", "4-3R", "4-4R", "5-1R", "5-2R", "5-3R", "5-4R", _
            "6-1R", "6-2R", "6-3R", "6-4R", "7-1R", "7-2R", "7-3R", "7-4R", "8-1R", "8-2R", "8-3R", "8-4R", "9-1R", "9-2R", _
            "9-3R", "9-4R", "10-1R", "10-2R", "10-3R", "10-4R", "11-1R", "11-2R", "11-3R", "11-4R", _
            "12-1R", "12-2R", "12-3R", "12-4R", "13-1R", "13-2R", "13-3R", "13-4R", "13-5R")).Select
End Sub
Private Sub Choisir_V()

    Sheets(Array("1-1V", "1-2V", "1-3V", "1-4V", "2-1V", "2-2V", "2-3V", "2-4V", "3-1V", _
            "3-2V", "3-3V", "3-4V", "4-1V", "4-2V", "4-3V", "4-4V", "5-1V", "5-2V", "5-3V", "5-4V", _
            "6-1V", "6-2V", "6-3V", "6-4V", "7-1V", "7-2V", "7-3V", "7-4V", "8-1V", "8-2V", "8-3V", "8-4V", "9-1V", "9-2V", _
            "9-3V", "9-4V", "10-1V", "10-2V", "10-3V", "10-4V", "11-1V", "11-2V", "11-3V", "11-4V", _
            "12-1V", "12-2V", "12-3V", "12-4V", "13-1V", "13-2V", "13-3V", "13-4V", "13-5V")).Select
End Sub

Private Sub Enlever_la_protection()
Dim i As Integer
    Application.ScreenUpdating = False
    Sheets(1).Select
    For i = 1 To 105
        ActiveSheet.Unprotect
        ActiveSheet.Next.Select
    Next i
    ActiveSheet.Unprotect
    Application.ScreenUpdating = True
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Protéger_feuille
' Auteur    : Claire
' Date      : 20/avril/2003
' But       : Protéger toutes les feuilles dans le but d'empècher des modifications sur les cellules avec formule.
'---------------------------------------------------------------------------------------

Private Sub Protéger_feuille()
Dim i As Integer

    Application.ScreenUpdating = False

    Sheets(1).Select
    For i = 1 To 105
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveSheet.EnableSelection = xlNoRestrictions

        ActiveSheet.Next.Select
    Next i
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

            Application.ScreenUpdating = True
End Sub

Dès que je mets un chiffre dans la case K9, la macro de la feuille103 démarre, appelle Créer.... et plante juste après mon changelink, elle veut redémarrer la macro de la feuille 103 laquelle a encore une valeur puisque, à partir de Effacer, rien ne s'est fait.

Je présume que c'est dans ma façon d'appeler la macro Effacer. J'ai aussi essayer avec Call Effacer_R, même chose.

Si j'exécute la Macro Créer... sans passer par la macro de la feuille103, elle fonctionne très bien.

Je n'y comprends plus rien, à mon secours

Claire

Le 07/04/2014 à 22:25

Bonsoir,

Essaie ce bout de code.

Si K9 est liée à d'autres cellules, cela peut expliquer tes bugs.

A te relire.

Public flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
    If flag Then Exit Sub
    If Range("K9") <> 0 Then
        flag = True
        MsgBox "Je crée le fichier de l'année prochaine."
        Call Créer_fichier_nouvelle_année
    End If
    flag = False
End Sub
Le 08/04/2014 à 00:34

Bonsoir Jean-Eric,

Cela marche à merveille. Il n'était pas lié à d'autres cellules.

Un gros merci,

Claire

Rechercher des sujets similaires à "appel macro mysterieux"