Discussion :

[Adilleroy]

Bonjour , Tous le Monde .J'ai un petit soucis sur une des partis du programme. En faite j'utilise une fonction CreationFichierData() , cette fonction qui est utilisé via des boutons , afin de crer une copie des résultats et des différentes feuilles du classeur . L'endroit ou ça bloque , c'est quand je cre un autre classeur Résultats et que ce classeur je le laisse ouvert , et je reclick une autre fois pour crer un autre fichier sous le meme nom , la ça bug , donc la solution que j'ai apporté à la fin du programme qui n'est encore complete , permet de verifier si y'a un classeur du meme nom qui ouvert ou non , Donc je compte sur vous afin de m'aider à résoudre ce petit probleme

Voila l'integralité du programme

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
 
Public Sub CreationFichierDatas()
 
Application.ScreenUpdating = False  'Mise à jour d'écran désactivée
Application.Interactive = False     'Bloque les interactions souris-clavier
Application.Calculation = xlCalculationManual   'Mode de calcul manuel
 
Dim FilePerma, FileSortie As String
'
    FilePerma = ActiveWorkbook.Name
    'choisir perma
    Workbooks.Add
    Résultats = ActiveWorkbook.Name
 
    Windows(FilePerma).Activate
    Worksheets("Conversion").Activate
    Cells.Select
    Selection.Copy
    Range("A1").Select
 
    Windows(Résultats).Activate
    Worksheets(1).Activate
    Worksheets(1).Name = "Conversion"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
    Range("A1").Select
 
 
    Windows(FilePerma).Activate
    Worksheets("Résultats finaux").Activate
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Windows(Résultats).Activate
    Worksheets(2).Activate
    Worksheets(2).Name = "Résultats finaux"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Range("A1").Select 'pour selectionner que la cellule A1au lieu de toute la feuille
 
 
 
    Windows(FilePerma).Activate
    Worksheets("Performances").Activate
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Windows(Résultats).Activate
    Worksheets(3).Activate
    Worksheets(3).Name = "Performances"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Range("A1").Select
 
 
 
 
    Windows(FilePerma).Activate
    Worksheets("Résultats finaux Imini").Activate
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Windows(Résultats).Activate
    Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=2
    'Worksheets(4).Activate
    ActiveSheet.Name = "Résultats finaux Imini"
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Range("A1").Select
 
 
 
 
     Windows(FilePerma).Activate
    Worksheets("Performances Imini").Activate
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Windows(Résultats).Activate
     Worksheets(5).Activate
    Worksheets(5).Name = "Performances Imini"
     Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
         Range("A1").Select
 
 
      With ActiveWorkbook
 
Do
ok = 0
On Error Resume Next
nomfichier = Application.GetSaveAsFilename("Résultats", "Classeur Microsoft Office Excel (*.xls), *.xls")
    If nomfichier = False Then
            .Close (False)
            ok = 1
            msg = MsgBox("ATTENTION fichier non sauvegardé", vbExclamation)
        Else
            Err.Clear
            Windows("Résultats.xls").IsOpen
            If Err = 0 Then
                    msg = MsgBox("ATTENTION fichier déja ouvert veuillez donner un nouveau nom.", vbExclamation)
                    Windows(Résultats).Activate
                Else
                    .SaveAs (nomfichier)
                    ok = 1
 
            End If
    End If
Loop Until ok = 1
    '***** Protection des formules (de traduction) du fichier données-resultats *****'
    For Each feuille In Workbooks(Workbooks.Count).Worksheets
        feuille.Protect
    Next feuille
 
     End With
 
Application.ScreenUpdating = True  'Mise à jour d'écran activée
Application.Interactive = True     'Débloque les interactions souris-clavier
Application.Calculation = xlCalculationAutomatic    'Mode de calcul automatique

[mayekeul]

bonjour,

sans trop bouger à ton code, voici un début de piste

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
 
Public Sub CreationFichierDatas()
 
Application.ScreenUpdating = False  'Mise à jour d'écran désactivée
Application.Interactive = False     'Bloque les interactions souris-clavier
Application.Calculation = xlCalculationManual   'Mode de calcul manuel
 
Dim FilePerma, FileSortie As String, Feuille
Dim WBresult As Workbook, Résultats As String, OK, Nomfichier, msg
 
'
    FilePerma = ActiveWorkbook.Name
    'choisir perma
    On Error Resume Next
    Set WBresult = GetObject("C:\...\Résultats.xlsx")    'prendre le fichier existant ouvert ou non
    On Error GoTo 0
    If WBresult Is Nothing Then Set WBresult = Workbooks.Add ' si le fichier n'existe pas, en créer un
    Résultats = WBresult.Name
    Application.Windows(Résultats).Visible = True
 
    Windows(FilePerma).Activate
    Worksheets("Conversion").Activate
...

[Adilleroy]

ben en faite mon programme , ne prenait pas le nom du fichier , mais il prenait son adresse C:.......\Résultats.Xls , du coup j'avais juste ajoute cette ligne qui m'a permet de recuperer que le nom du fichier et aprés ça marcher , mais merci comme meme

Code :

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

1
2
3
 
 
fichier = Right(Nomfichier, Len(Nomfichier) - InStrRev(Nomfichier, "\", -1, 1))