Taille de l'USF selon la recherche effectuée

[marcelio]

Bonjour à tous,

Sur ma feuille j'effectue une recherche et selon le résultat je voudrais que l'USF s'adapte à ma recherche

Joint fichier pour plus d'explications

Merci de votre aide

Marcelio

 

[STephane]

Re : Taille de l'USF selon la recherche effectuée

je n'ai pu remettre la main sur des trucs que j'avais déjà postés, alors je tente une réécriture. reste un gros problème : je n'arrive pas à faire fonctionner le défilement dans le cadre.

Dim resultats As Range, base_resultats As Range
Dim strPremiereCellule As Range
Dim ctlTextbox As Control
Dim i As Integer
Private Sub UserForm_Initialize()
i = 0: j = 0
Set strPremiereCellule = Worksheets("recherche").Range("D11")
Set base_resultats = strPremiereCellule.CurrentRegion
Set resultats = base_resultats.Offset(1, 0).Resize(base_resultats.Rows.Count - 1, base_resultats.Columns.Count)

For Each cl In resultats
    
    'ajout d'une boîte texte à l'intérieur du cadre "Frame1"
    Set ctlTextbox = Frame1.Controls.Add("Forms.Textbox.1", "Boîte Texte" & i, True)
    With ctlTextbox
        .Width = 55: .Height = 15
        .Left = rechercher.Frame1.Left + .Width * j
        .Top = rechercher.Frame1.Top + .Height * i
        .ControlTipText = ctlTextbox.Name 'infobulle
        .TextAlign = fmTextAlignLeft
        If cl.NumberFormat = "General" Then
            .Value = cl.Value
        Else
            .Value = Format(cl.Value, cl.NumberFormat)
        End If
    End With
    
    If j < resultats.Columns.Count - 1 Then
        j = j + 1
    Else
        j = 0
        i = i + 1
    End If
Next cl

Frame1.Width = 55 * (resultats.Columns.Count + 0.5)
Me.Width = Frame1.Width + 10
Me.Caption = "Résultats : " & i & " enregistrements"
Me.ScrollHeight = Frame1.Height
End Sub
Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
'pour faire une action à chaque création d'un contrôle
End Sub

 

[marcelio]

Re : Taille de l'USF selon la recherche effectuée

Bonjour Stéphane et le forum,

Désolé de répondre si tard

J'ai testé ton code et il à l'air de fonctionner
Mais dommage que l'on ne puisse pas dimensionné l'USF selon le nombre de ligne trouver
Par contre le problème de la barre de défilement m'embêté un peu

Peut on rétrécir les Textbox qui sont à partir de la gauche le 2°,4° et 6° plus petit que les autres
Et est il possible pour les textos de supprimer carrément le cadre
et de faire dans l'USF la 1° ligne (exemple) en jaune et la 2° en rouge et ainsi de suite

Je te remet le fichier avec ton code

Je te remercie d'avance

Marcelio

 

[PMO2]

Re : Taille de l'USF selon la recherche effectuée

Bonjour,

Je me suis beaucoup intéressé à la solution de STephane que je remercie pour m'avoir appris la technique des TextBox dynamiques dans une Frame.
En extrapolant, j'arrive à pratiquement satisfaire vos desiderata. Voici les codes et la démarche à suivre.

1) Créez un UserForm (propriété ShowModal = False)

2) Dans la fenêtre de code du UserForm copiez le code suivant (adaptez, à votre usage, les constantes cernées par des ###)

'### A adapter selon votre usage ###
Const FEUILLE As String = "recherche"
Const MAXIMUM_LIG As Long = 20
Const SANS_CADRE As Boolean = True
'###################################

Dim ColTextBox As New Collection

Private Sub UserForm_Initialize()
Dim obEvents As clsControlsEvents
Dim ctl As MSForms.Control
Dim S As Worksheet
Dim R As Range
Dim FR As MSForms.Frame
Dim TB As MSForms.TextBox
Dim A$
Dim var
Dim i&
Dim j&
Dim x&
Dim y&
Dim nbLig&
On Error GoTo Erreur
A$ = "La feuille ''" & FEUILLE & "'' est introuvable"
Set S = Worksheets(FEUILLE)
If S.[d10] = "" Then
  A$ = "La cellule D10 ne contient aucune donnée"
  GoTo Erreur
End If
A$ = ""
Set R = S.[d10].CurrentRegion
var = R
Set FR = Me.Controls.Add("Forms.Frame.1")
y& = FR.Top
For i& = 1 To UBound(var, 1)
  If var(i&, 1) <> "" Then
    nbLig& = nbLig& + 1
    x& = FR.Left
    For j& = 1 To UBound(var, 2)
      Set TB = FR.Controls.Add("Forms.TextBox.1")
      With TB
        .Tag = var(i&, j&)
        .BorderStyle = fmBorderStyleSingle
        .Height = 15
        If j& Mod 2 <> 0 Then
          .Width = 80
        Else
          .Width = 40
        End If
        .Left = x&
        x& = x& + .Width
        .Top = y&
        If j& = 4 Or j& = 6 Then
          .Value = Format(var(i&, j&), "00.00")
        Else
          .Value = var(i&, j&)
        End If
        If i& = 1 Then
          .TextAlign = fmTextAlignCenter
          .Font.Bold = True
        ElseIf IsNumeric(var(i&, j&)) Then
          .TextAlign = fmTextAlignRight
        End If
        If i& > 1 Then
          If i& Mod 2 = 0 Then
            .BackColor = vbYellow
            If SANS_CADRE Then .BorderColor = vbYellow
          Else
            .BackColor = vbRed
            If SANS_CADRE Then .BorderColor = vbRed
          End If
        Else
          .BackColor = vbCyan
          If SANS_CADRE Then .BorderColor = vbCyan
        End If
      End With
    Next j&
    y& = y& + TB.Height
  End If
Next i&
If nbLig& > MAXIMUM_LIG Then
  FR.Width = x& + 18
  FR.Height = (y& / nbLig&) * MAXIMUM_LIG
  Me.Height = FR.Height + 25
  FR.ScrollBars = fmScrollBarsVertical
  FR.ScrollHeight = FR.Height * (nbLig& / MAXIMUM_LIG)
Else
  FR.Width = x& + 5
  FR.Height = y& + 5
  Me.Height = FR.Height + 25
End If
Me.Width = FR.Width + 2
Me.Caption = ""
'--- Evènement Double Clic des TextBox ---
For Each ctl In Me.Controls
  If TypeOf ctl Is MSForms.TextBox Then
    Set obEvents = New clsControlsEvents
    Set obEvents.Tbx = ctl
    Set obEvents.Frm = Me
    ColTextBox.Add obEvents
  End If
Next ctl
Exit Sub
Erreur:
If A$ <> "" Then
  Me.Caption = A$
Else
  Me.Caption = "Erreur " & Err.Number & "   " & Err.Description
End If
End Sub

3) Créez un module de Classe, faites F4 pour faire apparaître la fenêtre de propriétés et mettez la propriété (Name) = clsControlsEvents
Copiez le code suivant dans le module de classe

Public WithEvents Tbx As MSForms.TextBox
Public Frm As UserForm

Private Sub Tbx_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim S As Worksheet
On Error Resume Next
Set S = Sheets(Tbx.Tag)
S.Activate
If Err <> 0 Then Cancel = True
End Sub

4) Servez-vous de votre feuille "recherche" qui doit être renseignée à partir de D10 sur x lignes et 6 colonnes et lancez le UserForm.
Un double clic sur une TextBox en son sein active la feuille du même nom dans la mesure où celle-ci existe.

Cordialement.

PMO
Patrick Morange

 

[marcelio]

Re : Taille de l'USF selon la recherche effectuée

Bonjour Patrick et le Forum,

Je viens de tester ton code sur mon programme et je te remercie
Tout fonctionne correctement sauf si je peux me permettre
Sur ma feuille ‘recherche’ de D11 à I48 ce ne sont que des formules
Or si je n’ai que 2 lignes (exemple) d’afficher l’USF lui est affiché en entier

Si tu à une autre solution à ce petit problème je te remercie d’avance

Je te souhaite une bonne journée ainsi qu’au forum.

Marcelio

 

[PMO2]

Re : Taille de l'USF selon la recherche effectuée

Bonjour,

Sur ma feuille ‘recherche’ de D11 à I48 ce ne sont que des formules
Or si je n’ai que 2 lignes (exemple) d’afficher l’USF lui est affiché en entier

Pouvez-vous envoyer un classeur édulcoré étant le reflet de ce qui est décrit ci-dessus pour que je puisse essayer de lui trouver une solution ?

Cordialement.

PMO
Patrick Morange

 

[marcelio]

Re : Taille de l'USF selon la recherche effectuée

Re,

Joint fichier

Cordialement

Marcelio

 

[PMO2]

Re : Taille de l'USF selon la recherche effectuée

Bonjour,

J'ai donc apporté les changements concernant la prise en compte des formules et j'ai modifié mon premier message ainsi que la pièce qui y était attachée.
Veuillez vous reporter à mon premier message pour télécharger la nouvelle pièce jointe.

Cordialement.

PMO
Patrick Morange

 

[marcelio]

Re : Taille de l'USF selon la recherche effectuée

Merci Patrick pour le nouveau code
tout est ok
Je te remercie beaucoup de ton aide

Bonne après midi à vous tous

A+

Marcelio