Re : Trait discontinu de deux couleurs
bonjour,
Impossible à moins de construire sa propre ligne, la première macro est une ébauche.
La seconde est un essai pour créer une connexion entre chaque pointillé, histoire de s'amuser (plutôt que d'utiliser un regroupement). Mais cela ne fonctionne pas
Une ébauche.
Sub ddd()
Dim cellule As Range, couleur
Dim CoinGaucheBasX, CoinGaucheBasY
Dim CoinGaucheHautX, CoinGaucheHautY
Dim CoinDroiteBasX, CoinDroiteBasY
Dim CoinDroiteHautX, CoinDroiteHautY
Set cellule = ActiveCell
CoinGaucheBasX = cellule.Left
CoinGaucheBasY = cellule.top
CoinGaucheHautX = cellule.Left
CoinGaucheHautY = cellule.top + cellule.Height
CoinDroiteBasX = cellule.Left + cellule.Width
CoinDroiteBasY = cellule.top
CoinDroiteHautX = cellule.Left + cellule.Width
CoinDroiteHautY = cellule.top + cellule.Height
couleur = vbGreen
For i = cellule.Left To (cellule.Left + cellule.Width) Step 10
With ActiveSheet.Shapes.AddLine(i, CoinGaucheBasY, i + 3, CoinDroiteBasY).Line
.DashStyle = msoLineDashDotDot
.Weight = xlThick
.ForeColor.RGB = couleur ' RGB(50, 0, 128)
couleur = IIf(couleur = vbGreen, vbYellow, vbGreen)
End With
If (i + 3) >= (cellule.Left + cellule.Width) Then Exit For
Next i
End Sub
Sub essai_de_connecteurs()
Dim firstShape As Shape
Dim cellule As Range, couleur
Dim CoinGaucheBasX, CoinGaucheBasY
Dim CoinGaucheHautX, CoinGaucheHautY
Dim CoinDroiteBasX, CoinDroiteBasY
Dim CoinDroiteHautX, CoinDroiteHautY
Set cellule = ActiveCell
CoinGaucheBasX = cellule.Left
CoinGaucheBasY = cellule.top
CoinGaucheHautX = cellule.Left
CoinGaucheHautY = cellule.top + cellule.Height
CoinDroiteBasX = cellule.Left + cellule.Width
CoinDroiteBasY = cellule.top
CoinDroiteHautX = cellule.Left + cellule.Width
CoinDroiteHautY = cellule.top + cellule.Height
couleur = vbGreen
For i = cellule.Left To (cellule.Left + cellule.Width) Step 10
Set currentShape = ActiveSheet.Shapes.AddLine(i, CoinGaucheBasY, i + 3, CoinDroiteBasY)
If firstShape Is Nothing Then Set firstShape = currentShape
With currentShape.Line
.DashStyle = msoLineDashDotDot
.Weight = xlThick
.ForeColor.RGB = couleur ' RGB(50, 0, 128)
couleur = IIf(couleur = vbGreen, vbYellow, vbGreen)
End With
If (i + 3) >= (cellule.Left + cellule.Width) Then Exit For
Next i
Set lastShape = currentShape
Set connexion = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 0, 0, 100, 100)
With connexion.ConnectorFormat
.BeginConnect ConnectedShape:=firstShape, ConnectionSite:=1
.EndConnect ConnectedShape:=lastShape, ConnectionSite:=1
End With
connexion.RerouteConnections
End Sub