exclure certaine feuille

[fpouzou]

je tente d'exclure certaine feuille de facon a ce qu'il ne prenne pas en compte

Option Explicit
Option Compare Text

Const Sign As String = "RECHERCHE"

Private Sub CommandButton3_Click() 'Bouton Modif
Dim lig, col As Integer
On Error GoTo a
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
lig = ActiveCell.Row
col = 1
Cells(lig, col).Select
If Cells(lig, 2).Value <> TextBox2.Value Or Cells(lig, 3) <> TextBox3.Value * 1 Then
Cells(lig, 4).Value = Date
End If
Cells(lig, 2).Value = TextBox2.Value
Cells(lig, 3).Value = TextBox3.Value * 1
Me.Frame1.Visible = False
Unload Me
a: Exit Sub
End Sub

Private Sub CommandButton4_Click() 'Bouton Supprimer
Dim lig, col As Integer
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
lig = ActiveCell.Row
col = 1
Cells(lig, col).Select
Cells(lig, 2).Value = "Vide"
Cells(lig, 3).Value = 0
Cells(lig, 4).Value = ""

End Sub

Private Sub ListBox1_Click()
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
TextBox2.Value = ListBox1.Column(1)
TextBox3.Value = ListBox1.Column(2)
Me.Frame1.Visible = True

End Sub

'ICI C'est la mise en place initialisation
Private Sub UserForm_Initialize()
    With ListBox1
     .ColumnCount = 4
     .ColumnWidths = "40;170;70;90"
    End With
Me.Caption = Sign
Me.CommandButton1.Default = True
Me.Frame1.Visible = False

End Sub


[COLOR="DarkOrange"]ICI C'est le Moteur de Recherche
[COLOR="red"]Private Sub CommandButton1_Click()[/COLOR]
Dim C As Range
Dim Tablo() As String
Dim Text As String
Dim S As Byte
Dim Firstaddress As String
Dim i As Integer, X As Integer, L As Integer
Select Case Sheets(S).Name
        Case "ACCUEIL", "Data", "Consolidation", "Rapport de tableau", "Graph1" ' mettre le nom des feuilles qui ne sont pas à utiliser"
 
        Case Else
Text = Me.TextBox1
If Text = "" Then Exit Sub

For S = 1 To Worksheets.Count
If Worksheets(S).Name <> "" Then
        With Sheets(S).UsedRange
        Set C = .Find(Text, LookIn:=xlValues, LookAt:=xlPart)
        If Not C Is Nothing Then
        Firstaddress = C.Address
        Do
        ReDim Preserve Tablo(8, i)
                    For X = 1 To 6
                        Tablo(X - 1, i) = C.Offset(0, X - C.Column).Text
                    Next X
            Tablo(6, i) = Sheets(S).Name
            Tablo(7, i) = C.Address(0, 0)
            i = i + 1
        Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Address <> Firstaddress
        End If
        End With
End If
Next S
If i = 0 Then
MsgBox "Le Texte " & Text & " n'a pas été trouvé" & vbCrLf & "Faites un essai sur une partie du nom", vbCritical, Sign
Exit Sub
End If
Me.ListBox1.Column() = Tablo()

[COLOR="Red"]End Sub[/COLOR][/COLOR]


'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.Frame1.Visible = False
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
Unload Me
End Sub



'ICI Sortie du UserForm
Private Sub CommandButton2_Click()
Unload Me
End Sub

je ne comprend pourquoi ?
merci de votre aide

je joint mon fichier si ca peux aider, lorsque la feuille graphique et la mon code plante c'est pour cette raison que je voudrais exclure la feuille grapique , accueil , data , consolidation , rapport de tableau

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[jp14]

Re : exclure certaine feuille

Bonjour

Ci dessous un code à tester

'ICI C'est le Moteur de Recherche
Private Sub CommandButton1_Click()
Dim C As Range
Dim Tablo() As String
Dim Text As String
Dim S As Byte
Dim Firstaddress As String
Dim i As Integer, X As Integer, L As Integer


Text = Me.TextBox1
If Text = "" Then Exit Sub

For S = 1 To Worksheets.Count
Select Case Sheets(S).Name
    Case "ACCUEIL", "Data", "Consolidation", "Rapport de tableau", "Graph1" ' mettre le nom des feuilles qui ne sont pas à utiliser"

    Case Else
        With Sheets(S).UsedRange
        Set C = .Find(Text, LookIn:=xlValues, LookAt:=xlPart)
        If Not C Is Nothing Then
            Firstaddress = C.Address
            
            Do
                ReDim Preserve Tablo(8, i)
                        For X = 1 To 6
                            Tablo(X - 1, i) = C.Offset(0, X - C.Column).Text
                        Next X
                Tablo(6, i) = Sheets(S).Name
                Tablo(7, i) = C.Address(0, 0)
                i = i + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> Firstaddress
            
        End If
        End With
End Select
Next S
If i = 0 Then
MsgBox "Le Texte " & Text & " n'a pas été trouvé" & vbCrLf & "Faites un essai sur une partie du nom", vbCritical, Sign
Exit Sub
End If
Me.ListBox1.Column() = Tablo()

End Sub

JP

 

[fpouzou]

Re : exclure certaine feuille

ca marche 🙂 !!!!!!! trop cool merci mille fois