Perte de données et plus aucune procédure ne s'exécute, sauf la procédure d'ouverture

**Tho69** · 07/08/2013, 12h01

Bonjour,

Je travaille sur la programmation d'un classeur Excel depuis quelque temps.
Aujourd'hui en ouvrant mon classeur je n'avais plus les dernières modifications faite à ce classeur la veille. Pourtant en allant dans les propriétés du documents je me suis aperçu que je l'avais bien enregistrer hier avant d'éteindre mon ordinateur. De plus maintenant quand je l'ouvre, la procédure d'ouverture s'execute mais ensuite plus moyen de lancer les autres procédures.

Si quelqu'un sait d'où peuvent venir ses deux symptômes, je suis tout ouïe.

Merci.

Thomas

**EngueEngue** · 07/08/2013, 12h05

Lecture Seule / Plantage d'excel / Fichier corrupt / Procédure d'ouverture qui fait quelque chose qui bloque.

Peut on voir ta procédure d'ouverture ?

Invité · 07/08/2013, 12h05

Bonjour

De plus maintenant quand je l'ouvre, la procédure d'ouverture s'execute mais ensuite plus moyen de lancer les autres procédures.

Je ne vois pas comment on peut savoir si on a pas le ou les codes qui se déclenchent, s'il y a des message d'erreurs ?

Philippe

**Tho69** · 07/08/2013, 12h10

Voila la procédure d'ouverture, la fonction qu'elle appelle et la fonction que cette fonction appelle.

Aucun message d'erreur.

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
Private Sub Workbook_Open()
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Const FileSource As String = "Sport"
 
Dim WkbSrce As Workbook
Dim FoldersSource As Variant
Dim SubFolder As String
Dim i As Integer
Dim x As Integer
Dim y As Integer
 
y = ThisWorkbook.Worksheets.Count
 
For x = 2 To y
 
    SubFolder = ThisWorkbook.Worksheets(x).Name
 
    If SubFolder Like "STR####" Then
        FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
    ElseIf SubFolder Like "SCR####" Then
        FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
    Else
        Exit Sub
    End If
 
    For i = 0 To UBound(FoldersSource)
        If Importer(FoldersSource(i), SubFolder, FileSource & ".xlsx") Then
            Exit For 'fichier trouvé
        End If
    Next i
 
Next x
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub

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
Private Function Importer(ByVal Dossier As String, ByVal SousDossier As String, ByVal Fichier As String) As Boolean
 
Dim FichTrouve As String, SubFolder As String
Dim WkbSrce As Workbook
 
Application.ScreenUpdating = False
 
SubFolder = FindSubFolder(Dossier, SousDossier) 'Appelle la fonction FindSubFolder
 
If SubFolder <> "" Then
    FichTrouve = Dir(SubFolder & "\" & Fichier)
 
    If FichTrouve <> "" Then
        Importer = True
        Do While FichTrouve <> ""
            Set WkbSrce = Application.Workbooks.Open(SubFolder & "\" & Fichier)
            WkbSrce.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(SousDossier)
 
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(SousDossier).Delete
            Application.DisplayAlerts = True
 
            ThisWorkbook.Worksheets("Affaire").Name = SousDossier
 
            Application.ScreenUpdating = True
 
            WkbSrce.Close False
            Set WkbSrce = Nothing
            FichTrouve = Dir()
 
            Application.ScreenUpdating = True
 
        Loop
    End If
End If
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Function FindSubFolder(ByVal Folder As String, Numéro_affaire As String) As String 'Cherche le sous répertoire
 
Dim Tmp As String
 
ChDrive "C:\"
ChDir Folder
Tmp = Dir("*" & Numéro_affaire & "*", vbDirectory)
If Tmp <> "" Then FindSubFolder = Folder & Tmp
 
End Function

**EngueEngue** · 07/08/2013, 12h13

Vire les displayalerts = False et relance, puis tu nous dis quelle erreur t'affiche-t-il

**Tho69** · 07/08/2013, 12h19

Merci à vous,

Sans les displayalerts = False, toujours aucune erreur.

Et voici une des procédures qui ne se lance pas quand j'insère une feuille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Workbook_NewSheet(ByVal Sh As Object)
 
UserForm2.Show
 
End Sub

Et oui, j'ai une UserForm2

Et oui, cette procédure est dans ThisWorkbook

**EngueEngue** · 07/08/2013, 12h21

Et si tu la lances manuellement ?

**nibledispo** · 07/08/2013, 20h22

Bonsoir,

Le fichier s'ouvre mais on ne peut s'en servir à cause des cheminS qui n'existent sur notre ordinateur et sans doutes d'autres raisons.

J'ai passé CCleaner et AdwCleaner après installation de ton fichier et rien d'anormal n'a été signalé. tu peux donc, je pense, l'installer sans risque sur ton ordi perso mais tu seras confronté au même problème de chemin.

Par ailleurs, j'ai remarqué que userform2 et thiswor... avaient tout deux une function importer. Si cela est d'origine et ne résulte pas d'une modification récente, elles ne peuvent être la cause d'un conflit éventuel. dans le cas contraire, qui sait ....

cordialement.

**Tho69** · 08/08/2013, 10h54

Bonjour,

J'AI CIBLE CE ***** DE BUG

. Je savais que le problème devait venir de moi

.

J'ai désactiver la procédure d'ouverture. Le restent fonctionnait parfaitement. Sauf une chose bizarre: l'ouverture de UF2 à l'insertion d'une feuille ne se fesait qu'une fois ensuite plus moyen de relancer quoi que ce soit. Alors je me suis dis qu'elle est le lien entre l'affichage de UF2 et la procédure d'ouverture, aucun à première vu et SI: elle sélectionne des feuilles. J'ai désactiver la procédure se lancant à la sélection d'une feuille et houra plus aucun soucis.
Par contre il me reste à comprendre pourquoi cette procédure fonctionne parfaitement toute seule en passant d'une feuille à une autre manuellement et quand elle est couplé à d'autre procédure cela rend impossible le lancemant d'une procédure par la suite.
C'est d'autant plus dur à comprendre que: aucun msg d'erreurs, la procédure d'ouverture qui sélectionne plusieurs feuilles se déroule parfaitement jusqu'à sa fin, et l'insertion d'une nouvelle feuille tout simple ne devrait pas poser de problèmes(le fichier n'est pas trouvé car le nom de la nouvelle feuille ne correspond pas à un fichier donc rien ne devrait se passer.

**EngueEngue** · 08/08/2013, 11h23

Remplace ces procédures et refait le test

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Application.DisplayAlerts = False
 
Const FileSource As String = "Sport"
 
Dim WkbSrce As Workbook
Dim FoldersSource As Variant
Dim SubFolder As String
Dim i As Integer
Dim x As Integer
Dim y As Integer
 
x = Target.Row
y = Target.Column
 
' Windows("CHECK-LIST SUIVI AFFAIRE.xlsm").Activate
           ' Sheets(SousDossier).Select
            Cells(x, y).Select
            Application.CutCopyMode = False
            Selection.Copy
 
SubFolder = ThisWorkbook.ActiveSheet.Name
 
If SubFolder Like "STR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
ElseIf SubFolder Like "SCR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
Else
Application.DisplayAlerts = True
 
    Exit Sub
End If
 
For i = 0 To UBound(FoldersSource)
    If Exporter(FoldersSource(i), SubFolder, FileSource & ".xlsx") Then
        Exit For 'fichier trouvé
    End If
Next i
 
Application.DisplayAlerts = True
 
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
 
Const FileSource As String = "Sport"
 
Dim WkbSrce As Workbook
Dim FoldersSource As Variant
Dim SubFolder As String
Dim i As Integer
 
SubFolder = ThisWorkbook.ActiveSheet.Name
 
If SubFolder Like "STR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
ElseIf SubFolder Like "SCR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
Else
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
    Exit Sub
End If
 
For i = 0 To UBound(FoldersSource)
    If Importer(FoldersSource(i), SubFolder, FileSource & ".xlsx") Then
        Exit For 'fichier trouvé
    End If
Next i
 
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub