Fonction renvoyant true si feuille existe

[Dolichotis]

Bonjour,

Le titre est assez explicite : je cherche une fonction qui renvoie true si la feuille "alpha" existe dans le classeur A. J'ai cherché sur le forum mais je n'ai pas trouvé. Si vous pouvez me proposer une fonction ou m'indiquer un lien, ça m'aiderait beaucoup.

Merci d'avance !

(Question subsidiaire : j'ai un problème avec la deuxième ligne -> erreur d'exécution : variable objet ou variable de bloc with non définie)

wsA.Range("B" & Lig & ",D" & Lig & ",E" & Lig & "").Copy
wsOutil.Range("B" & Lig).PasteSpecial xlPasteValuesAndNumberFormats

Sachant que j'ai déclaré toutes mes variables, est-ce un problème de syntaxe ? Merci !)

 

[Staple1600]

Re : Fonction renvoyant true si feuille existe

Bonsoir


Pour la subsidaire (à tester)
wsA.Range("B" & Lig & "," & "D" & Lig & "," & "E" & Lig).Copy

 

[cbea]

Re : Fonction renvoyant true si feuille existe

Bonjour Dolichotis,

Voici des solutions :
1/ Remplacer :

wsA.Range("B" & Lig & ",D" & Lig & ",E" & Lig [COLOR="Red"]& ""[/COLOR]).Copy

par :

wsA.Range("B" & Lig & ",D" & Lig & ",E" & Lig).Copy

2/ Voici une fonction :
Remplacer "lafeuille" par le nom qui correspond à la feuille à vérifier

Function trouveWS(lafeuille As Worksheet) As Boolean
    Dim wsFeuil As Worksheet
    
    trouveWS = False
    ' Boucle sur toutes les feuilles du classeur
    For Each wsFeuil In ThisWorkbook.Worksheets
        ' La feuille est trouvée
        If wsFeuil.Name = lafeuille.Name Then
            trouveWS = True
            Exit For
        End If
    Next wsFeuil
End Function

 

[tototiti2008]

Re : Fonction renvoyant true si feuille existe

Bonjour à tous,

Function FeuilleExiste(NomFeuil As String) As Boolean
Dim Existe As Boolean, Test
Existe = True
On Error GoTo erreur
Test = Worksheets(NomFeuil).Range("A1").Value
FeuilleExiste = Existe
On Error GoTo 0
Exit Function
erreur:
Existe = False
Resume Next
End Function

Edit : une autre possibilité...

 

[Staple1600]

Re : Fonction renvoyant true si feuille existe

Re


Une autre version

Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the [B]sheet[/B] exists in the active workbook
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function

Pour tester

sub Example()
If Not SheetExists("MySheetName") Then
    MsgBox "MySheetName doesn't [B]exist[/B]!"
Else
    Sheets("MySheetName").Activate
End If
end sub

source:
Erlandsen Data Consulting

 

[Dolichotis]

Re : Fonction renvoyant true si feuille existe

Merci à tous !

Comme je dois rentrer maintenant, j'essaierai demain !

Encore merci.

 

[Dolichotis]

Re : Fonction renvoyant true si feuille existe

Bonjour et encore désolée d'être partie précipitamment hier soir mais j'avais des obligations.

J'ai tester ce matin mon code mais j'ai un problème. Le compilateur n'est pas d'accord quand je lui mets un nom de classeur qui n'existe (dans certains cas) pas encore. (Enfin je crois que c'est pour qu'il me met l'indice n'appartient pas à la sélection !

Je ne sais pas comment contourner le problème. Si vous avez une idée à me souffler, je vous en remercie !

Cette procédure doit, quand on clique sur un bouton chargement automatique, demander le numéro d'un classeur B puis l'ouvrir ; récupérer des données dedans et les mettre dans le classeur A dans une feuille copiée d'un autre classeur C si elle n'existe pas dans le classeur A.

Option Explicit

'chargement automatique
Private Sub CommandButton2_Click()

'déclaration des variables
    Dim ligDeb As Integer, ligFin As Integer
    Dim Lig As Integer, derLig As Integer
    
    Dim wbOutil As Workbook, wsOutil As Worksheet
    Dim wbABC As Workbook, wsABC As Worksheet
    Dim wbComposant As Workbook, wsComposant As Worksheet
    
    Dim numABC As String, TypeComp As String
    Dim cheminComplet As String, chemin As String
           
    'classeur et feuille Outil
    Set wbOutil = ThisWorkbook
        
    'chemins des classeurs
    cheminComplet = wbOutil.FullName
    cheminComplet = Replace(cheminComplet, "" & ActiveWorkbook.Name & "", "")
    chemin = ActiveWorkbook.Name
        
    'récupération du numéro de l'ABC
    numABC = InputBox("Numéro de l'ABC : ", "Chargement automatique")

    'Vérifier que le fichier existe dans le répertoire
    If (Dir("" & cheminComplet & "ABC" & numABC & "_MNO.xls") = "") Then
        MsgBox "Le fichier ABC" & numABC & "_MNO .xls est introuvable.", vbCritical, "Erreur !"
        Exit Sub
    Else
        'ouvrir le fichier
        Workbooks.Open filename:="" & cheminComplet & "ABC" & numABC & "_MNO.xls"
    End If
    
    'classeur et feuille ABC
    Set wbABC = ActiveWorkbook
    Set wsABC = wbABC.Worksheets("Nomenclature")
    
    'initialisation des variables
    ligDeb = 20 'première ligne des feuilles du classeur
    ligFin = wsABC.Range("A" & Cells.Rows.Count).End(xlUp).Row 'dernière ligne de la feuille alpha du classeur Outil
        
    For Lig = ligDeb To ligFin
        TypeComp = wsABC.Range("L" & Lig)
        Set wsOutil = wbOutil.Worksheets("" & TypeComp & "")
            'si la feuille est déjà ouverte
            If (trouveWS(wsOutil) = True) Then
                'ajouter une ligne dans la feuille concernée de l'outil
                wsOutil.Activate
                Call ajoutLigne
        Else
            'ouverture du classeur alpha
            Set wbComposant = Workbooks.Open("" & cheminComplet & "composants\" & TypeComp & "")
            'wsOutil correspond à la première feuille du fichier
            Set wsComposant = wbComposant.Worksheets(1)
            
            'coller la première feuille dans le classeur outil et le renommer
            wsComposant.Copy after:=Workbooks(chemin).Sheets(2)
            wbComposant.Close
            ActiveSheet.Name = "" & TypeComp & ""
            
            'copier de l'ABC vers l'outil
            wsABC.Range("B" & Lig & ",D" & Lig & ",E" & Lig).Copy
            wsOutil.Range("B" & Lig).PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End If
    Next
        wbABC.Close
            End Sub

    
    'fonction renvoie true si le classeur est ouvert
    Function trouveWS(lafeuille As Worksheet) As Boolean
    Dim wsFeuil As Worksheet
    
    trouveWS = False
    ' Boucle sur toutes les feuilles du classeur
    For Each wsFeuil In ThisWorkbook.Worksheets
        ' La feuille est trouvée
        If wsFeuil.Name = lafeuille.Name Then
            trouveWS = True
            Exit For
        End If
    Next wsFeuil
End Function

'ajoutLigne
Sub ajoutLigne()
    Range("A21:I21").Copy
    Selection.Insert Shift:=xlDown
    Range("A21").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End Sub

 

[cbea]

Re : Fonction renvoyant true si feuille existe

Bonjour Dolichotis et à tous,

Voici les modifications apportées (à tester) :

Function trouveWS([COLOR="red"]wb As Workbook, lafeuille As String[/COLOR]) As Boolean
    ' fonction renvoie true si la feuille existe dans la classeur
    Dim wsFeuil As Worksheet
    
    trouveWS = False
    ' Boucle sur toutes les feuilles du classeur
    For Each wsFeuil In [COLOR="red"]wb.[/COLOR]Worksheets
        ' La feuille est trouvée
        If wsFeuil.Name = lafeuille Then
            trouveWS = True
            Exit For
        End If
    Next wsFeuil
End Function

Private Sub CommandButton2_Click()

    'déclaration des variables
    Dim ligDeb As Integer, ligFin As Integer
    Dim Lig As Integer, derLig As Integer
    
    Dim wbOutil As Workbook, wsOutil As Worksheet
    Dim wbABC As Workbook, wsABC As Worksheet
    Dim wbComposant As Workbook, wsComposant As Worksheet
    
    Dim numABC As String, TypeComp As String
    Dim cheminComplet As String, chemin As String
           
    'classeur et feuille Outil
    Set wbOutil = ThisWorkbook
        
    'chemins des classeurs
    cheminComplet = wbOutil.FullName
    cheminComplet = Replace(cheminComplet, "" & ActiveWorkbook.Name & "", "")
    chemin = ActiveWorkbook.Name
        
    'récupération du numéro de l'ABC
    numABC = InputBox("Numéro de l'ABC : ", "Chargement automatique")

    'Vérifier que le fichier existe dans le répertoire
    If (Dir("" & cheminComplet & "ABC" & numABC & "_MNO.xls") = "") Then
        MsgBox "Le fichier ABC" & numABC & "_MNO .xls est introuvable.", vbCritical, "Erreur !"
        Exit Sub
    Else
        'ouvrir le fichier
        Workbooks.Open Filename:="" & cheminComplet & "ABC" & numABC & "_MNO.xls"
    End If
    
    'classeur et feuille ABC
    Set wbABC = ActiveWorkbook
    Set wsABC = wbABC.Worksheets("Nomenclature")
    
    'initialisation des variables
    ligDeb = 20 'première ligne des feuilles du classeur
    ligFin = wsABC.Range("A" & Cells.Rows.Count).End(xlUp).Row 'dernière ligne de la feuille alpha du classeur Outil
        
    For Lig = ligDeb To ligFin
        TypeComp = wsABC.Range("L" & Lig)
        
        'si la feuille est déjà ouverte
        If ([COLOR="Red"]trouveWS(wbOutil, TypeComp[/COLOR]) = True) Then
            [COLOR="red"]Set wsOutil = wbOutil.Worksheets("" & TypeComp & "")[/COLOR]
            'ajouter une ligne dans la feuille concernée de l'outil
            wsOutil.Activate
            Call ajoutLigne
        Else
            'ouverture du classeur alpha
            Set wbComposant = Workbooks.Open("" & cheminComplet & "composants\" & TypeComp & "")
            'wsOutil correspond à la première feuille du fichier
            Set wsComposant = wbComposant.Worksheets(1)
            
            'coller la première feuille dans le classeur outil et le renommer
            wsComposant.Copy after:=Workbooks(chemin).Sheets(2)
            wbComposant.Close
            ActiveSheet.Name = "" & TypeComp & ""
            
            'copier de l'ABC vers l'outil
            wsABC.Range("B" & Lig & ",D" & Lig & ",E" & Lig).Copy
            wsOutil.Range("B" & Lig).PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End If
    Next
    wbABC.Close
End Sub

 

[Dolichotis]

Re : Fonction renvoyant true si feuille existe

Bonjour cbea !

Merci pour ta modification, j'ai essayé et ça marche nickel !