VBA: Tester si une Feuille existe dans un autre classeur

JerCaz

XLDnaute Occasionnel
Bonjour le forum,

grâce à pas mal de lecture sur le forum, j'arrive très modestement à me débrouiller en VBA...
Mais là, je sèche!!!

Pour le centre hospitalier où je travaille, j'ai donc créé un fichier de gestion de l'occupation des lits dans les différents services. Ce fichier est mensuel : j'ai donc un fichier "bed manager - 01-12.xls", un autre nommé "bed manager 02-12.xls", etc... Dans ces fichiers, j'ai un onglet récapitulatif par semaine (ex: dans février, j'ai les onglets semaine 5, semaine 6, semaine 7, etc...)

J'ai besoin de comparer des données avec le fichier de l'année précédente. (par exemple, pour le mois de janvier
Pour cela, grâce à l'enregistreur de macros, j'ai réussi à créer un bout de code qui importe les données de l'année précédente.

Mais le problème suivant se pose : il arrive parfois que l'année précédente, le semaine X ou Y ne faisait pas partie du fichier car pas partie du même mois.

Pour éviter que ma macro ne me crée des liens inexistants (et donc afficher des #REF!#), je souhaite vérifier l'existence de feuilles dans un classeur Excel fermé.


En fouillant sur le forum, j'ai trouvé ce fil:
https://www.excel-downloads.com/threads/tester-lexistence-dune-feuille.57585/
mais le problème, c'est qu'il permet de ne faire la recherche d'une feuille nommée que dans le classeur actif.

Avec mon ami google, j'ai donc trouvé ce code:
Code:
Sub essai()

'essai par exemple sur une feuille appelée rencontre dans le classeur actif

If existsheet(ActiveWorkbook, "rencontre") Then
MsgBox "existe"
Else
MsgBox "n'existe pas"
End If

End Sub

Function existsheet(wb As Workbook, ws As String) As Boolean

On Error Resume Next
Set wse = wb.Sheets(ws)

If Err.Number <> 0 Then
Err.Clear
Exit Function
End If

existsheet = True

End Function

Pour ne pas avoir à adapter manuellement ce bout de code chaque mois, j'ai donc essayé de le modifier pour qu'il repère seul le mois et l'année du fichier ouvert, pour rechercher celui de l'année précédente (Cf. document joint).

Mais cela ne fonctionne pas: j'obtiens une erreur de compilation / Type d'argument ByRef incompatible

Essayant d'adapter bêtement le code sans vraiment comprendre ce que l'erreur signifie, je viens donc ici solliciter votre aide.

Vous remerciant par avance pour l'aide que vous pourrez m'apporter,
Bien cordialement,
Jérôme.
 

Pièces jointes

  • Bed manager - 02-12.xls
    27 KB · Affichages: 125

job75

XLDnaute Barbatruc
Re : VBA: Tester si une Feuille existe dans un autre classeur

Bonjour Jercaz,

Activez n'importe quelle feuille de semaine et lancez cette macro :

Code:
Sub Test()
Dim fich$, an As Byte, f$, chemin$, v As Variant
fich = ThisWorkbook.Name
an = Val(Mid(fich, InStr(fich, "-") + 1))
fich = Application.Replace(fich, InStr(fich, "-") + 1, 2, an - 1)
f = ActiveSheet.Name
chemin = ThisWorkbook.Path & "\[" & fich & "]" & f
v = ExecuteExcel4Macro("'" & chemin & "'!R1C1")
MsgBox "Feuille '" & f & IIf(IsError(v), "' introuvable", "' trouvée") _
  & " dans '" & fich & "'..."
End Sub
Je vais voir si sur le même principe on peut créer une fonction.

Nota 1 : la cellule A1 ne doit pas contenir une valeur d'erreur.

Nota 2 : la macro fonctionne quelle que soit l'extension du fichier (xls ou xlsm).

Nota 3 : les fichiers doivent être dans le même répertoire.

EDIT : ah la barbe, je n'avais pas vu que le nom du fichier a 2 traits d'union...

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : VBA: Tester si une Feuille existe dans un autre classeur

Re,

Bon finalement utilisez cette macro :

Code:
Sub Test()
Dim fich$, an As Byte, f$, chemin$, v As Variant
fich = ThisWorkbook.Name
an = Val(Mid(fich, InStrRev(fich, ".") - 2))
fich = Application.Replace(fich, InStrRev(fich, ".") - 2, 2, an - 1)
f = ActiveSheet.Name
chemin = ThisWorkbook.Path & "\[" & fich & "]" & f
v = ExecuteExcel4Macro("'" & chemin & "'!R1C1")
MsgBox "Feuille '" & f & IIf(IsError(v), "' introuvable", "' trouvée") _
  & " dans '" & fich & "'..."
End Sub
Il faut bien sûr que les noms des fichiers ne diffèrent que par l'année...

A+
 

JerCaz

XLDnaute Occasionnel
Re : VBA: Tester si une Feuille existe dans un autre classeur

Bonjour job75,

un grand merci pour vos réponses et votre savoir-faire : cela fonctionne parfaitement !!!
Je vous souhaite une bonne soirée,
Cordialement,

JerCaz
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : VBA: Tester si une Feuille existe dans un autre classeur

Bonsoir
Trop Tard , pendant que je regardais les réponses arrivaient ... bon tant mieux
J'avais trouvé qu'il te manquait un : DIM classeur AS Workbook > A savoir lors d'un passage de param a une fonction il faut avoir le meme type dans la SUB ( vient d'enn faire l'expérience)
mais il restait encore une erreur sur This workbook
Bien, bonne continuation
 

job75

XLDnaute Barbatruc
Re : VBA: Tester si une Feuille existe dans un autre classeur

Re,

Pas de problème pour créer la fonction macro FeuilExist :

Code:
Sub Test()
Dim fich$, an As Byte, f$
fich = ThisWorkbook.Name
an = Val(Mid(fich, InStrRev(fich, ".") - 2))
fich = Application.Replace(fich, InStrRev(fich, ".") - 2, 2, an - 1)
f = ActiveSheet.Name
MsgBox "Feuille '" & f & IIf(FeuilExist(fich, f), "' trouvée", "' introuvable") _
  & " dans '" & fich & "'..."
End Sub

Function FeuilExist(fich$, f$) As Boolean
Dim chemin$, v As Variant
chemin = ThisWorkbook.Path & "\[" & fich & "]" & f
v = ExecuteExcel4Macro("'" & chemin & "'!R1C1")
FeuilExist = Not IsError(v)
End Function
A+
 

job75

XLDnaute Barbatruc
Re : VBA: Tester si une Feuille existe dans un autre classeur

Re,

Pas bien testé... Il y avait problème si les 2 fichiers sont ouverts.

Il faut utiliser On Error Resume Next dans les 2 solutions :

Code:
Sub Test()
Dim fich$, an As Byte, f$, chemin$, v As Variant
fich = ThisWorkbook.Name
an = Val(Mid(fich, InStrRev(fich, ".") - 2))
fich = Application.Replace(fich, InStrRev(fich, ".") - 2, 2, an - 1)
f = ActiveSheet.Name
chemin = ThisWorkbook.Path & "\[" & fich & "]" & f
On Error Resume Next
v = ExecuteExcel4Macro("'" & chemin & "'!R1C1")
MsgBox "Feuille '" & f & IIf(IsError(v) Or Err, "' introuvable", "' trouvée") _
  & " dans '" & fich & "'..."
End Sub
Code:
Sub Test()
Dim fich$, an As Byte, f$
fich = ThisWorkbook.Name
an = Val(Mid(fich, InStrRev(fich, ".") - 2))
fich = Application.Replace(fich, InStrRev(fich, ".") - 2, 2, an - 1)
f = ActiveSheet.Name
MsgBox "Feuille '" & f & IIf(FeuilExist(fich, f), "' trouvée", "' introuvable") _
  & " dans '" & fich & "'..."
End Sub

Function FeuilExist(fich$, f$) As Boolean
Dim chemin$, v As Variant
chemin = ThisWorkbook.Path & "\[" & fich & "]" & f
On Error Resume Next
v = ExecuteExcel4Macro("'" & chemin & "'!R1C1")
FeuilExist = Not IsError(v) And Err = 0
End Function
A+
 

Discussions similaires