Nombre d'images contenues dans userform

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Trier par date Trier par votes
Bonjour Pierre

Je te remercie mais j'ai un souci le nombre d'image est dépendant de ma liste que j'ai en colonne "A" pour cela j'ai un code comme ceci
Code: 
Private Sub UserForm_Initialize()
Dim Obj As Control, i%, Larg_Img%, Haut_Img%, Haut_Lbl%, cpt%, rang%, iMin%, iMax%, reste%
Larg_Img = 120
Haut_Img = 80
Haut_Lbl = 12
NbQ = [ListNom].Count
Arr = [ListNom].Value
cpt = 0
rang = 0

Do
iMin = 1 + 8 * rang
iMax = IIf(8 + 8 * rang <= NbQ, 8 + 8 * rang, NbQ)
For i = iMin To iMax
cpt = cpt + 1
   Set Obj = Me.Controls.Add("Forms.image.1")
   With Obj
      .Name = "img" & Format(i, "000")
      On Error Resume Next    '(en cas de photos manquantes)
      '.Picture = LoadPicture(Chemin & Arr(cpt, 1) & ".jpg") ', 250, 178)
      .Picture = LoadPicture("J:\covers small\" & Arr(cpt, 1) & ".jpg") ', 250, 178)
      On Error GoTo 0
      .PictureSizeMode = 3 '  Format 3= proportionnel
      .Tag = Format(i, "000")
     
      .BackStyle = 0 'BackStyle transparent
      .BorderStyle = 0 'BorderStyle None
     
      .Left = 12 + (Larg_Img + 12) * ((i - 1) Mod 8)
      .Top = 12 + (Haut_Img + 12) * (rang)
      .Width = Larg_Img
      .Height = Haut_Img
   End With
   ReDim Preserve Img_Trombi(1 To iMax)
   Set Img_Trombi(i).Trombi = Obj
  
   Set Obj = Me.Controls.Add("Forms.label.1")
   With Obj
      .Name = "Lbl" & Format(i, "000")
      .Tag = Format(i, "000")
      .BackStyle = 0  'BackStyle transparent
      .Caption = Arr(i, 1)
      .ForeColor = &HE0E0E0 'Police Label
      .Left = 12 + (Larg_Img + 12) * ((i - 1) Mod 8)
      .Top = 92 + (92) * (rang)
      .Width = Larg_Img
      .Height = 12
   End With
   ReDim Preserve Lbl_Trombi(1 To iMax)
   Set Lbl_Trombi(i).LblNam = Obj
  
Next i
rang = rang + 1
Loop Until cpt = NbQ

With UserForm1
k = (12 + Larg_Img) * 8 + 30
   .Width = k
   reste = IIf(Int([ListNom].Count / 10) * 10 < [ListNom].Count, 1, 0)
   .ScrollHeight = 72 * (Int([ListNom].Count / 10) + reste) + 12
   .Height = IIf(rang <= 7, 36 + (92 * rang), 516)
   .Caption = "Covers"  'Caption User
   .BackColor = &H80000012 'Couleur de fond "Noir"
End With
End Sub

et lui me trouve 1 image alors qu'il y a na 60 normale......

Je te remercie
 
Vote positif 0 Vote négatif
Re,

Non je ne suis pas arriver même avec un compteur déclaré en Public.
Mon code User avec ton code est:
Code: 
Public cpt As Integer
Private Sub UserForm_Activate()
Me.ScrollTop = 0
End Sub

Private Sub UserForm_Initialize()
Dim Obj As Control, i%, Larg_Img%, Haut_Img%, Haut_Lbl%, cpt%, rang%, iMin%, iMax%, reste%
Larg_Img = 120
Haut_Img = 80
Haut_Lbl = 12
NbQ = [ListNom].Count
Arr = [ListNom].Value
cpt = 0
rang = 0

Do
iMin = 1 + 8 * rang
iMax = IIf(8 + 8 * rang <= NbQ, 8 + 8 * rang, NbQ)
For i = iMin To iMax
cpt = cpt + 1
   Set Obj = Me.Controls.Add("Forms.image.1")
   With Obj
      .Name = "img" & Format(i, "000")
      On Error Resume Next    '(en cas de photos manquantes)
      '.Picture = LoadPicture(Chemin & Arr(cpt, 1) & ".jpg") ', 250, 178)
      .Picture = LoadPicture("J:\covers small\" & Arr(cpt, 1) & ".jpg") ', 250, 178)
      On Error GoTo 0
      .PictureSizeMode = 3 '  Format 3= proportionnel
      .Tag = Format(i, "000")
     
      .BackStyle = 0 'BackStyle transparent
      .BorderStyle = 0 'BorderStyle None
     
      .Left = 12 + (Larg_Img + 12) * ((i - 1) Mod 8)
      .Top = 12 + (Haut_Img + 12) * (rang)
      .Width = Larg_Img
      .Height = Haut_Img
   End With
   ReDim Preserve Img_Trombi(1 To iMax)
   Set Img_Trombi(i).Trombi = Obj
  
   Set Obj = Me.Controls.Add("Forms.label.1")
   With Obj
      .Name = "Lbl" & Format(i, "000")
      .Tag = Format(i, "000")
      .BackStyle = 0  'BackStyle transparent
      .Caption = Arr(i, 1)
      .ForeColor = &HE0E0E0 'Police Label
      .Left = 12 + (Larg_Img + 12) * ((i - 1) Mod 8)
      .Top = 92 + (92) * (rang)
      .Width = Larg_Img
      .Height = 12
   End With
   ReDim Preserve Lbl_Trombi(1 To iMax)
   Set Lbl_Trombi(i).LblNam = Obj
  
Next i
rang = rang + 1
Loop Until cpt = NbQ

With UserForm1
k = (12 + Larg_Img) * 8 + 30
   .Width = k
   reste = IIf(Int([ListNom].Count / 10) * 10 < [ListNom].Count, 1, 0)
   .ScrollHeight = 72 * (Int([ListNom].Count / 10) + reste) + 12
   .Height = IIf(rang <= 7, 36 + (92 * rang), 516)
   '.Height = IIf(rang <= 7, 150 + (92 * rang), 700)
   .Caption = "Covers"  'Caption User
   .BackColor = &H80000012 'Couleur de fond "Noir"
End With


For Each ctrl In UserForm1.Controls
        If TypeName(ctrl) = "Image" Then
Label1 = ("L'" & UserForm1.Name & " possede " & nb & " Images")
End If
Next
End Sub

A moins que je me suis tromper
@+
 
Vote positif 0 Vote négatif
Bonsoir maval
Bonsoir le fil,Le Forum
Avec cette procédure tu n'arrives à rien car la variable nb n'est pas incrémentée , il me semble
VB: 
For Each ctrl In UserForm1.Controls
        If TypeName(ctrl) = "Image" Then
Label1 = ("L'" & UserForm1.Name & " possede " & nb & " Images")
End If
il me semble qu'en reprenant la procédure de pierrejean et la recherche par type de tatiak
tu devrais y arrive
soit :
VB: 
For Each ctrl In UserForm1.Controls
  If TypeName(ctrl) = "Image" Then
  nb = nb + 1
  End If
Next
MsgBox ("L'" & UserForm1.Name & " possede " & nb & " Images")
pas sur d'avoir tout compris LOL
Bonne fin de Soirée
Amicalement
Jean marie
 
Vote positif 0 Vote négatif
Bonjour Max
Bonjour le Fil,Le Forum

Peut être comme ceux ci !! Lol
VB: 
With Userform1
    For Each ctrl In .Controls
      If TypeName(ctrl) = "Image" Then
      nb = nb + 1
      End If
    Next
       .Caption = "L'" & .Name & " possede " & nb & " Images"
End With
Bonne fin de Journée
Amicalement
Jean Marie
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

patricktoulon
  • Résolu(e)
Autres Problème avec mon algo de creation de patchWork
Réponses
5
Affichages
216
patricktoulon
patricktoulon
Z
  • Question Question
XL 2019 Connaitre le nombre d'enregistrement dans ma BDD
Réponses
7
Affichages
402
zenzy27
Z
M
  • Résolu(e)
XL 2021 Classement de valeurs contenues dans 2 tableaux d'une même feuille
Réponses
7
Affichages
299
MATLEA
M
gh4
  • Question Question
Autres impossible de convertir nombre texte en nombre
Réponses
8
Affichages
340
dysorthographie
dysorthographie
J
  • Question Question
XL 2016 classeur rendez-vous avec userform en VBA
Réponses
4
Affichages
122
J- Paul
J
V
  • Résolu(e)
Microsoft 365 Excel: repérer un changement de nombre dans une plage de cellules
Réponses
5
Affichages
185
sylvanu
sylvanu
AIXELS
  • Question Question
Microsoft 365 Afficher un userform sans titre
Réponses
2
Affichages
163
AIXELS
AIXELS
frederio
  • Question Question
XL 2019 Le Résultat rechercher match aller / retour dans UserForm
Réponses
5
Affichages
256
frederio
frederio
L
  • Résolu(e)
Power Query DataSource.Error : Exécution d'une requête dont le fichier source est ouvert
2
Réponses
23
Affichages
715
Leché
L
D
  • Résolu(e)
XL 2016 Filtrage ListBox d'un userform
Réponses
6
Affichages
225
dgil37
D
B
  • Question Question
XL 2021 Recopie anniversaire dans calendrier
Réponses
7
Affichages
200
Dranreb
Dranreb
E
  • Résolu(e)
Microsoft 365 Calcul Pourcentage dans Userform
Réponses
6
Affichages
245
job75
job75
Yann71
  • Question Question
Microsoft 365 Impression recto-verso
Réponses
2
Affichages
162
Yann71
Yann71
A
  • Résolu(e)
XL 2021 tirage au sort aléatoire sans doublon
2 3 4
Réponses
54
Affichages
745
bsalv
B
E
  • Résolu(e)
XL 2016 Verrouiller page avec accès "filtre" + "mise en page personnalisée"
Réponses
9
Affichages
431
Phil69970
Phil69970
P
  • Résolu(e)
XL 2021 Suivi fréquentation clientèle
Réponses
9
Affichages
290
Pedro_92
P
J
  • Résolu(e)
XL 2021 Classement données avec recherchex en cas de données de même valeur
Réponses
6
Affichages
147
jeff2318
J
L
  • Résolu(e)
XL 2016 formule nombre de véhicules mensuel
2 3
Réponses
34
Affichages
1 K
Lionel 25
L
Dudu2
  • Question Question
XL 2021 EXCEL bousille le contexte dans un cas très particulier (pour les forts en thème... et en version)
Réponses
3
Affichages
182
TooFatBoy
TooFatBoy
P
  • Question Question
XL 2021 inscrire le nombre d'une cellule dans une liste dans une colonne
Réponses
6
Affichages
423
OKBI
O
Retour