Bonjour,
sur une feuille excel, j'ai des cellules a choix multiples (similaire a des cellules ayant une validation par liste) mais j'utilise a la place un userform (combo-box) avec une macro car je veux afficher un choix de smileys (police wingdings)
Ca marche tres bien (réactivtié en temps réel) mais des que je rajoute des captures de graphes (presents sur une autre feuille) sur cette feuille avec l'outil photo d'excel j'ai un pb de rafraichissement.
Chaque fois que je clic sur une cellule smiley pour le changer, il met 3-4 secondes avant de me rendre la main!
ci-apres mon code (sous Excel 2003)
je ne vois pas ce qui cloche ou ce qui active ce rafraichissement global de la feuille.
Merci de votre aide
========================================================
Option Explicit
Option Base 1
Dim oComboBox As OLEObject
Private Function IsWingdingsBox(ByVal target As Range, ByRef sType As String) As Boolean
Dim flag As Boolean
If Intersect(target, Union(Range("SmileyBox1"), Range("SmileyBox2"))) Is Nothing Then
If Intersect(target, Range("TendanceBox")) Is Nothing Then
flag = False
sType = ""
Else
flag = True
sType = "Tendance"
End If
Else
flag = True
sType = "Smiley"
End If
IsWingdingsBox = flag
End Function
Private Sub MyComboBox_Change()
With oComboBox
'4:vert , 44: orange , 3: rouge
'J:smiley content, K:smiley neutre, L:smiley triste, M:bombe
If .Object.Text = "J" Then
.TopLeftCell.Font.ColorIndex = 4
ElseIf .Object.Text = "K" Then
.TopLeftCell.Font.ColorIndex = 44
ElseIf .Object.Text = "L" Or .Object.Text = "M" Then
.TopLeftCell.Font.ColorIndex = 3
End If
End With
End Sub
Private Sub Worksheet_Activate()
Set oComboBox = ActiveSheet.OLEObjects("MyComboBox")
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim sType As String
With oComboBox
If IsWingdingsBox(target, sType) Then
'if the cell is a smiley or tendance cell
'show the combobox with the list
.Left = target.Left
.Top = target.Top
.Width = target.Width + 15
.Height = target.Height
If sType = "Smiley" Then
.ListFillRange = "Smiley"
.Object.Font.Size = 28
Else
.ListFillRange = "Tendance"
.Object.Font.Size = 10
End If
.LinkedCell = target.Address
.Visible = True
Else
If .Visible Then
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End If
End If
End With
End Sub
sur une feuille excel, j'ai des cellules a choix multiples (similaire a des cellules ayant une validation par liste) mais j'utilise a la place un userform (combo-box) avec une macro car je veux afficher un choix de smileys (police wingdings)
Ca marche tres bien (réactivtié en temps réel) mais des que je rajoute des captures de graphes (presents sur une autre feuille) sur cette feuille avec l'outil photo d'excel j'ai un pb de rafraichissement.
Chaque fois que je clic sur une cellule smiley pour le changer, il met 3-4 secondes avant de me rendre la main!
ci-apres mon code (sous Excel 2003)
je ne vois pas ce qui cloche ou ce qui active ce rafraichissement global de la feuille.
Merci de votre aide
========================================================
Option Explicit
Option Base 1
Dim oComboBox As OLEObject
Private Function IsWingdingsBox(ByVal target As Range, ByRef sType As String) As Boolean
Dim flag As Boolean
If Intersect(target, Union(Range("SmileyBox1"), Range("SmileyBox2"))) Is Nothing Then
If Intersect(target, Range("TendanceBox")) Is Nothing Then
flag = False
sType = ""
Else
flag = True
sType = "Tendance"
End If
Else
flag = True
sType = "Smiley"
End If
IsWingdingsBox = flag
End Function
Private Sub MyComboBox_Change()
With oComboBox
'4:vert , 44: orange , 3: rouge
'J:smiley content, K:smiley neutre, L:smiley triste, M:bombe
If .Object.Text = "J" Then
.TopLeftCell.Font.ColorIndex = 4
ElseIf .Object.Text = "K" Then
.TopLeftCell.Font.ColorIndex = 44
ElseIf .Object.Text = "L" Or .Object.Text = "M" Then
.TopLeftCell.Font.ColorIndex = 3
End If
End With
End Sub
Private Sub Worksheet_Activate()
Set oComboBox = ActiveSheet.OLEObjects("MyComboBox")
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim sType As String
With oComboBox
If IsWingdingsBox(target, sType) Then
'if the cell is a smiley or tendance cell
'show the combobox with the list
.Left = target.Left
.Top = target.Top
.Width = target.Width + 15
.Height = target.Height
If sType = "Smiley" Then
.ListFillRange = "Smiley"
.Object.Font.Size = 28
Else
.ListFillRange = "Tendance"
.Object.Font.Size = 10
End If
.LinkedCell = target.Address
.Visible = True
Else
If .Visible Then
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End If
End If
End With
End Sub