Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Vba excel clique sur les images (résolu)

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion eideal44
  • 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
E

eideal44

Guest
Bonjour,

J'aimerais savoir si j'ai la possibilité de réduire mon code ci-dessous car j'ai 17 images donc 17 click possibles :

'*******************************************************************
Sub Image0_Click()
If Label78.Caption = "PRESENT AU CENTRE" Then
Label78.Caption = "PRESENT EN ENTREPRISE"
Label58.BackColor = &H80C0FF
Label78.BackColor = &H80C0FF
Label58.ForeColor = &H80000012
Label78.ForeColor = &H80000012
​
ElseIf Label78.Caption = "PRESENT EN ENTREPRISE" Then
Label78.Caption = "PREVISIONNEL ENTREPRISE"
Label58.BackColor = &H80FFFF
Label78.BackColor = &H80FFFF
Label58.ForeColor = &H80000012
Label78.ForeColor = &H80000012​
ElseIf Label78.Caption = "PREVISIONNEL ENTREPRISE" Then
Label78.Caption = "PRESENT AU CENTRE"
Label58.BackColor = &HFFC0C0
Label78.BackColor = &HFFC0C0
Label58.ForeColor = &H80000012
Label78.ForeColor = &H80000012​
End If
​
End Sub
'*******************************************************************
Sub Image1_Click()
If Label79.Caption = "PRESENT AU CENTRE" Then
​
Label79.Caption = "PRESENT EN ENTREPRISE"
Label59.BackColor = &H80C0FF
Label79.BackColor = &H80C0FF
Label59.ForeColor = &H80000012
Label79.ForeColor = &H80000012
​
ElseIf Label79.Caption = "PRESENT EN ENTREPRISE" Then
​
Label79.Caption = "PREVISIONNEL ENTREPRISE"
Label59.BackColor = &H80FFFF
Label79.BackColor = &H80FFFF
Label59.ForeColor = &H80000012
Label79.ForeColor = &H80000012​
ElseIf Label79.Caption = "PREVISIONNEL ENTREPRISE" Then
​
Label79.Caption = "PRESENT AU CENTRE"
Label59.BackColor = &HFFC0C0
Label79.BackColor = &HFFC0C0
Label59.ForeColor = &H80000012
Label79.ForeColor = &H80000012
​
End If
​
End Sub
'*******************************************************************
Sub Image2_Click()
If Label80.Caption = "PRESENT AU CENTRE" Then
​
Label80.Caption = "PRESENT EN ENTREPRISE"
Label60.BackColor = &H80C0FF
Label80.BackColor = &H80C0FF
Label60.ForeColor = &H80000012
Label80.ForeColor = &H80000012
​
ElseIf Label80.Caption = "PRESENT EN ENTREPRISE" Then
​
Label80.Caption = "PREVISIONNEL ENTREPRISE"
Label60.BackColor = &H80FFFF
Label80.BackColor = &H80FFFF
Label60.ForeColor = &H80000012
Label80.ForeColor = &H80000012​
ElseIf Label80.Caption = "PREVISIONNEL ENTREPRISE" Then
​
Label80.Caption = "PRESENT AU CENTRE"
Label60.BackColor = &HFFC0C0
Label80.BackColor = &HFFC0C0
Label60.ForeColor = &H80000012
Label80.ForeColor = &H80000012
​
End If
​
End Sub
'*******************************************************************
Sub Image4_Click()
If Label81.Caption = "PRESENT AU CENTRE" Then
​
Label81.Caption = "PRESENT EN ENTREPRISE"
Label61.BackColor = &H80C0FF
Label81.BackColor = &H80C0FF
Label61.ForeColor = &H80000012
Label81.ForeColor = &H80000012
​
ElseIf Label81.Caption = "PRESENT EN ENTREPRISE" Then
​
Label81.Caption = "PREVISIONNEL ENTREPRISE"
Label61.BackColor = &H80FFFF
Label81.BackColor = &H80FFFF
Label61.ForeColor = &H80000012
Label81.ForeColor = &H80000012​
ElseIf Label81.Caption = "PREVISIONNEL ENTREPRISE" Then
​
Label81.Caption = "PRESENT AU CENTRE"
Label61.BackColor = &HFFC0C0
Label81.BackColor = &HFFC0C0
Label61.ForeColor = &H80000012
Label81.ForeColor = &H80000012​
End If
​
End Sub
'*******************************************************************

Ai-je la possibilité de faire une boucle sur les 17 images?

Merci d'avance pour vos retours car je ne vois pas trop comment l'automatiser

Eideal44
 
Dernière modification par un modérateur:
Trier par date Trier par votes
Re : Vba excel clique sur les images

Bonjour eideal44,

Pas bien compris ce que vous voulez faire.

Voyez le fichier (2) joint où 30 semaines sont toujours affichées.

SEM 1 suit SEM 52 comme vous le souhaitez. Mais quel est l'intérêt ???

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Re,

Ah oui j'ai compris, pas bien en forme ce matin 🙄

Il faut remettre le compteur des semaines à zéro quand on change d'année :

Code: 
Dim mem As Byte
'---
If mem = 0 And Year(CDate(TextBox4) + 7 * B) > Year(CDate(TextBox4)) Then _
  mem = DatePart("ww", TextBox4, 2, 2) + B - 1
Controls("Label" & M + B) = "SEM " & DatePart("ww", TextBox4, 2, 2) + B - mem
Fichier (3).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Re,

En fait c'est bien plus simple, il suffit d'écrire :

Code: 
Controls("Label" & M + B) = "SEM " & DatePart("ww", CDate(TextBox4) + 7 * B, 2, 2)
pour que le Label prenne le n° de semaine de l'année suivante quand nécessaire.

Edit : par ailleurs, dans la boucle, il vaut mieux un On Error Resume Next si l'image n'existe pas...

Fichier (4).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Re,

Ce n'était pas parfait : il faut boucler sur tous les Labels => For B = 0 To 29.

De cette manière on peut modifier les dates sans fermer l'USF.

Fichier (5).

Edit : réinitialisé aussi les couleurs et ENTREE et SORTIE n'ont rien à faire dans la boucle.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Bonjour eideal44, le forum,

Pour revenir au sujet, une simplification de la macro dans le Module de classe :

Code: 
Private Sub MyImage_Click()
Dim n As Byte, L42 As Control, L12 As Control, TB6 As Control, TB35 As Control, choix As Byte
n = Replace(MyImage.Name, "Image", "")
Set L42 = UserForm3.Controls("Label" & 42 + n)
Set L12 = UserForm3.Controls("Label" & 12 + n)
Set TB6 = UserForm3.Controls("Textbox" & 6 + n)
Set TB35 = UserForm3.Controls("Textbox" & 35 + n)
choix = Application.Match(L42, Array("PRESENT AU CENTRE", "PRESENT EN ENTREPRISE", "PREVISIONNEL ENTREPRISE"), 0)
L42 = Choose(choix, "PRESENT EN ENTREPRISE", "PREVISIONNEL ENTREPRISE", "PRESENT AU CENTRE")
L42.BackColor = Choose(choix, &H80C0FF, &H80FFFF, &HFFC0C0)
L12.BackColor = L42.BackColor
L42.ForeColor = Choose(choix, &H80000012, &H80000012, &H80000012)
L12.ForeColor = L42.ForeColor
TB6.Visible = Choose(choix, True, True, False)
TB35.Visible = TB6.Visible
End Sub
Fichier (6).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Merci job75. Par contre petite question, si je veux reprendre le frame3 de l'userform3 et le copier dans l'userform1, est ce que c'est possible avec le module de classe?
 
Vote positif 0 Vote négatif
Re : Vba excel clique sur les images

Merci Job75 pour tous vos retours car sans vous, j'aurais peut-etre pu aller au bout du fichier mais cela m'aurait pris beaucoup plus de temps mais uassi beaucoup plus de code. Je joins le fichier définitif si cela peut aider quelqu'un et encore un GRAND MERCI à Job75.
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

  • Question Question
Microsoft 365 datepicker dynamique intra userform ou dans feuille 2 versions(frame dynamique)(toute version d'excel )
6 7 8
Réponses
105
Affichages
5 K
Usine à gaz
  • Question Question
Microsoft 365 [VBA] Listes déroulantes à choix multiples sur N colonnes discontinues
Réponses
4
Affichages
822
ralph45
L
  • Question Question
Microsoft 365 ouverture fichier pptx sur sharepoint (vba)
Réponses
2
Affichages
774
lesoldat9
L
L
  • Résolu(e)
XL 2019 Formulaire Excel - TxtBox avec couleur de la celle associée
Réponses
4
Affichages
805
Lindsay_RBD
L
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
769
Gégé-45550
M
  • Question Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
805
MBEPID
M
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
519
Latias
L
C
  • Résolu(e)
XL 2013 afficher image dans Userform via HyperText
Réponses
5
Affichages
975
Cyril-neo
C
S
  • Question Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
1 K
salma_hayek
S
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
645
JJ69
J
D
  • Question Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
1 K
crocrocro
C
L
  • Question Question
Microsoft 365 VBA sur outlook
Réponses
14
Affichages
1 K
lesoldat9
L
2
  • Résolu(e)
Microsoft 365 Code VBA avec plusieurs conditions SI
Réponses
6
Affichages
735
D.D.
D
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
2 K
Vermithor
V
P
  • Résolu(e)
erreur d'exécution "9" vba sur plage
Réponses
3
Affichages
929
piskely
P
L
  • Question Question
XL 2016 VBA Excel : Valeur récapituler sur un seul Mail
Réponses
10
Affichages
1 K
Gégé-45550
  • Question Question
XL 2016 Excel vba : faire une action sur certaines feuilles d'un classeur
Réponses
7
Affichages
946
Dranreb
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
C
  • Question Question
Microsoft 365 Convertir macro en script (faire marcher macro sur sharepoint)
Réponses
2
Affichages
3 K
crazy
C
D
  • Question Question
XL 2016 Problème de conversion sur VBA Excel
Réponses
1
Affichages
578
vgendron
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…