Bonjour le forum,
je viens vous consulter pour un problème de decallage de position.
Je cherche a créer en dessous de chaque cellule colorer, une forme rectangulaire transparente de même couleur, avec un Offset de 1 pour la colonne, ce que j'arrive parfaitement a faire.
Seulement plus on progresse dans les colonnes (progression de 1 a 100), plus le decallage vers la gauche s'accentue.
Voici le code:
Sub Solution()
Dim RGBC As Long
Dim Blue As Integer
Dim Green As Integer
Dim Red As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim W As Single
i = 0
j = 0
k = 0
With Worksheets(1)
For i = 1 To 30
For j = 1 To 100
If .Cells(i, j).Interior.ColorIndex < 0 Then
Else: .Cells(i, j).Activate
RGBC = ActiveCell.Interior.Color
Red = Int(RGBC Mod 256)
Green = Int((RGBC Mod 65536) / 256)
Blue = Int(RGBC / 65536)
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Offset(1, 0).Top, ActiveCell.Width, ActiveCell.Height)
With .Fill
.ForeColor.RGB = RGB(Red, Green, Blue)
.Transparency = 0.5
End With
With .Line
.DashStyle = msoLineSingle
.ForeColor.RGB = RGB(Red, Green, Blue)
End With
End With
k = 0
End If
Next j
Next i
End With
Et le fichier en PJ.
Je suppose que cela vient du ActiveCell.Left mais je ne comprends pas pourquoi cela ne me donne pas la position exacte.
Merci de votre aide!
je viens vous consulter pour un problème de decallage de position.
Je cherche a créer en dessous de chaque cellule colorer, une forme rectangulaire transparente de même couleur, avec un Offset de 1 pour la colonne, ce que j'arrive parfaitement a faire.
Seulement plus on progresse dans les colonnes (progression de 1 a 100), plus le decallage vers la gauche s'accentue.
Voici le code:
Sub Solution()
Dim RGBC As Long
Dim Blue As Integer
Dim Green As Integer
Dim Red As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim W As Single
i = 0
j = 0
k = 0
With Worksheets(1)
For i = 1 To 30
For j = 1 To 100
If .Cells(i, j).Interior.ColorIndex < 0 Then
Else: .Cells(i, j).Activate
RGBC = ActiveCell.Interior.Color
Red = Int(RGBC Mod 256)
Green = Int((RGBC Mod 65536) / 256)
Blue = Int(RGBC / 65536)
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Offset(1, 0).Top, ActiveCell.Width, ActiveCell.Height)
With .Fill
.ForeColor.RGB = RGB(Red, Green, Blue)
.Transparency = 0.5
End With
With .Line
.DashStyle = msoLineSingle
.ForeColor.RGB = RGB(Red, Green, Blue)
End With
End With
k = 0
End If
Next j
Next i
End With
Et le fichier en PJ.
Je suppose que cela vient du ActiveCell.Left mais je ne comprends pas pourquoi cela ne me donne pas la position exacte.
Merci de votre aide!