Discussion :

[Oh so sick]

Bonjour tout le monde !

J'aimerai tester la présence d'une feuille ou dans un autre classeur qui contient les archives des feuilles de pointage.

Actuellement j'utilise cette fonction :

Code :

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

1
2
3
4
5
6
7
8
9
Private Function Existe(ByVal Wbk As Workbook, ByVal Str As String) As Boolean
Dim Sh As Worksheet
For Each Sh In Wbk.Sheets
    If UCase(Sh.Name) = UCase(Str) Then
        Existe = True
        Exit For
    End If
Next Sh
End Function

Avec ce code :

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
Sub Enregistrecommun()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
Application.ScreenUpdating = False
Chemin = "/Users/joan/Desktop/AXIANS/"
Fichier = "Feuille de pointage commun.xlsx"
Fact = "S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("L6").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("I6")
If Dir(Chemin & Fichier) = "" Then
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then
        Set Sh = Wbk.Worksheets.Add(before:=Wbk.Sheets(1))
        Sh.Name = Fact
        ThisWorkbook.Worksheets(Fact).Shapes("Image 1").Copy
        ActiveSheet.Range("D39").PasteSpecial
        ThisWorkbook.Worksheets(Fact).Range("A1:Q37").Copy
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Wbk.Worksheets(Fact).Range("A1").Select
        ActiveWindow.Zoom = 75
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Activate
        Worksheets("Pointage").Range("D11:P35").ClearContents
        Worksheets("Pointage").Range("R3").ClearContents
       Sheets("Pointage").Shapes("Confirmation").DrawingObject.Value = 0
       Sheets("Pointage").Shapes("imprimer").DrawingObject.Value = 0
        Set Sh = Nothing
        Wbk.Close True
        Set Wbk = Nothing   
    Else
    Set Sh = Wbk.Worksheets(Fact)
        ThisWorkbook.Worksheets(Fact).Range("A1:Q37").Copy
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
        Wbk.Worksheets(1).Activate
        Workbooks("Feuille de pointage.xlsm").Worksheets(Fact).Activate
        Worksheets(Fact).Range("A1").Select
        Worksheets("Pointage").Activate
              Worksheets("Pointage").Range("D11:P35").ClearContents
    Worksheets("Pointage").Range("R3").ClearContents
    Sheets("Pointage").Shapes("Confirmation").DrawingObject.Value = 0
    Sheets("Pointage").Shapes("imprimer").DrawingObject.Value = 0
        Set Sh = Nothing
        Wbk.Close True
        Set Wbk = Nothing      
    End If
End If
End Sub

Si la feuille existe il le remplace, sinon il la créer, et il enregistre le document et le ferme.
Cependant le code pose problème, si un autre classeur est ouvert il l'utilise pour le code.

J'avais exactement le même principe pour enregistrer la nouvelle feuille non pas sur le commun mais sur un classeur personnel, je l'ai donc changé pour cette fonction :

Code :

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

1
2
3
4
5
Public Function FeuilleInexistante(ByVal strNomFeuille As String) As Boolean
 
FeuilleInexistante = IsError(Evaluate("='" & strNomFeuille & "'!A1"))
 
End Function

Il retourne TRUE si strNomFeuille est le nom d'une feuille qui n'existe pas dans le classeur actif.

Je l'utilise avec ce code dans mon module :

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
Sub Enregistrefeuille()
Dim x As Integer
strNomFeuille = "S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("L6").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("I6")
If FeuilleInexistante(strNomFeuille) Then
With ThisWorkbook
        .Sheets.Add(After:=.Sheets(1)).Name = strNomFeuille
        ActiveWindow.Zoom = 75
        ActiveWindow.DisplayGridlines = False
End With
        Worksheets("Pointage").Shapes("Image 1").Copy
        Worksheets(strNomFeuille).Range("D39").PasteSpecial
        Worksheets("Pointage").Range("A1:Q37").Copy
With Worksheets(strNomFeuille).Range("A1")
       .PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted
       .PasteSpecial Paste:=8 ' Paste the column widths
       .PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc)
End With
Else
        Worksheets("Pointage").Range("A1:Q37").Copy
With Worksheets(strNomFeuille).Range("A1")
        .PasteSpecial xlPasteValuesAndNumberFormats 'Paste only the values and how the values are formatted
        .PasteSpecial Paste:=8 ' Paste the column widths
        .PasteSpecial xlPasteFormats ' Paste cell formats (boarders, colors, etc)
End With
End If
        Application.CutCopyMode = False
With Worksheets("Pointage")
        .Activate
        .Range("D11:P35").ClearContents
        .Range("R3").ClearContents
        .Shapes("Confirmation").DrawingObject.Value = 0
        .Shapes("imprimer").DrawingObject.Value = 0
End With
End Sub

Le code peut sembler lourd pour copier les informations mais j'utilise les cellules I6 et L6 pour indiquer automatiquement la semaine en cours avec la cellule R3 pour modifier ou créer une semaine spécifique. A l'avenir je compte changer l'utilisation de formule dans ces cellules pour l'intégrer en VBA et donc pouvoir utiliser la méthode de transfert plutôt qu'un specialpast.

Voilà est-il possible selon vous d'adapter la fonction feuilleinexistante afin qu'elle teste la présence ou non du classeur sur le commun, qu'elle le créer si il n'est pas présent, qu'elle teste également l'existence ou non d'une feuille ?

De plus, il y a t'il des choses a améliorer dans le codage ?

Toute aide est la bienvenue, je vous remercie

Ci-joint mon classeur Excel, j'ai désactiver la fonction enregistre commun, il faut remplacer enregistrefeuille pour la réactiver.

[patricktoulon]

re
perso plus tu va dans tes explications moins je te comprends
le comun c'est quoi?
comment travaille tu avec un classeur executeur sur 2 autre classeurs
un classeur maitre et un autre classeur
je suis persuadé que ce que tu demande est tres simple

recommence ton exposé en toute lettre en precisant ta facon de fonctionner

[Patrice740]

Bonjour,

Tu pourrais commencer par supprimer l'utilisation des objets actifs (ActiveSheet et ActiveWindow).

[Philippe Tulliez]

Bonjour,
Pour tester l'existence d'une feuille, voici un exemple d'une fonction qui renvoie True ou False suivant l'existence ou pas du nom de la feuille

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
Function IsSheetExist(SheetName As String, Optional Wkb As Workbook) As Boolean
  ' http://philippe.tulliez.be
  ' Renvoie True ou False
  ' Arguments
  ' SheetName (String) Nom de la feuille dont on teste l'existence
  ' [wkb] (Workbook)   ThisWorkbook est le classeur par défaut
  Dim Sht As Worksheet
  If Wkb Is Nothing Then Set Wkb = ThisWorkbook
  On Error Resume Next
  Set Sht = Wkb.Sheets(SheetName)
  With Err
    If .Number Then .Clear Else IsSheetExist = True
  End With
  Set Sht = Nothing
End Function

Exemple d'un code qui crée une feuille si elle n'existe pas dans un autre classeur ouvert

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub TestIsSheetExist()
  Dim wb As Workbook
  Dim ShName As String
  Set wb = Workbooks("DashBoard Map Brussels.xlsb")
  ShName = "MagicOffice"
  If Not IsSheetExist(ShName, wb) Then
    With wb
    .Worksheets.Add            ' Ajoute une feuille
    .ActiveSheet.Name = ShName ' Renomme la feuille
    End With
  End If
End Sub

[Oh so sick]

Re !

@ patricktoulo : Je travaille avec un classeur (Feuille de pointage) ou la première feuille (Pointage) sert a saisir la semaine de pointage, lors de l'éxecution de la macro une nouvelle feuille est créer dans ce même classeur à la suite (et pour toutes les semaines), mais également dans un 2eme classeur (Feuille de pointage commun) qui se trouve sur le serveur de l'entreprise afin que l'assistante puisse saisir les semaines informatiquement.

Là est ma question concernant le teste de présence de feuille dans un autre classeur. Il faudrait sue ce code puisse :
- Verifier si le classeur dans le commun existe sinon le créer (pour les nouveaux entrant dans l'entreprise)
- Vérifier si la feuille S(numéro de semaine) - (année) existe, si oui il la modifie sans changer son ordre dans les feuilles si non il créer une nouvelle feuille positionner en premier (garder une cohérence dans les dates au niveau de l'organisation des feuilles).

@Philippe Tulliez : Merci de votre aide tout le monde mais au lieux de repartir sur un nouveau code est-il possible selon vous d'intégrer dans mon code qui teste déjà la présence de la semaine de pointage dans le classeur ou se trouve le modèle et l'archive perso pour qu'il puisse aussi tester la présence des feuilles dans le classeur commun ?

D'après le code est-il correct car il n'utilise pas de gestion d'erreur, c'est mieux non ?

@Patrice 740 : C'est ce que j'ai fait au maximum mais comme dit précédemment j'utilise encore le Pastspécial en raison de l'automatisation des dates en formule, une fois celle-ci basculer sur un code VBA je pourrais utiliser pour copier la méthode de transfert.

Merci de votre aide !

[Philippe Tulliez]

Bonjour
A une question précise, réponse précise.
Ta demande initiale était

J'aimerai tester la présence d'une feuille ou dans un autre classeur qui contient les archives des feuilles de pointage

J'ai publié une fonction qui renvoie True si la feuille existe et False dans la négative

Si la feuille existe il le remplace, sinon il la créer, et il enregistre le document et le ferme.

J'ai publié un exemple qui crée une feuille dans le classeur concerné si la feuille n'existe pas.

Si tu veux réussir à avoir une application pérenne, Il faut isoler chaque problème et ne pas vouloir tout faire dans une procédure.
Ainsi que le nom de la feuille que tu cherches soit le résultat de la combinaison de année an cours + le mois en cours + le numéro de semaine ou bien se nomme Toto n'est pas important pour la fonction qui vérifie si elle existe. La construction du nom de la feuille doit se faire en amont de la fonction qui vérifie son existence même si elle même peut être le résultat renvoyé par une fonction.

Scinde donc tes problèmes et ouvre autant de discussions qu'il n'y a de problème à résoudre

[patricktoulon]

re
une utilisation détournée de "ExecuteExcel4Macro"
verifie si le classeur existe avec le cheminet son nom et verifie aussi si la feuille existe tu a le resultat dans les deux messages
sans l'ouvrir !!!!

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
Sub test2()
    Dim chemin$, fichier$, feuille$
    chemin = "C:\Users\polux\DeskTop"
    fichier = "sans mask.xlsm"
    feuille = "Feuil1"
    retour = existe(chemin, fichier, feuille)
    MsgBox "le classeur : " & retour(1)
    MsgBox "la feuille : " & retour(2)
End Sub
'
Function existe(ByVal chemin As String, ByVal fichier As String, ByVal feuille As String)
    Dim Rc$, tbl(1 To 2)
    If Dir(chemin & "\" & fichier) <> "" Then
        tbl(1) = True
        tbl(2) = Not IsError(ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & "R1C1"))
    End If
    existe = tbl
End Function

[Co_bra]

Trop bien

simple et efficace

Merci