Pour un planning, j'utilise un rectangle de couleur rouge de hauteur 1
pour me repérer. J'ai créé cette macro avec l'aide de quelques uns sur
ce forum et vous en reremercie.
Malheureusement, je travaille à 95% sur excel 2000.
Lorsque je dois ouvrir ce fichier sur excel 2003 voir excel 2007, ma
macro fonctionne mal.
Est ce que l'un de vous pourrais me donner une piste pour gérer les
versions et faire en sorte que ma macro fonctionne correctement sur
toutes les versions ?
le but est d'afficher ce rectangle au milieu de la ligne active et du
début de la colonne 2 à la fin de la colonne 251
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
JLuc
Zut, fausse manoeuvre :D voilà le code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Largeur entre la cellule active et la première colonne PosHorizontal = Cells(Target.Row, 2).Left
' Position verticale sur ligne 2 ou plus PosHaut = Application.WorksheetFunction.Max((Cells(Target.Row, 2).Top + (Cells(Target.Row, 2).Height / 2)), _ (Cells(2, 5).Top + (Cells(2, 5).Height / 2)))
' longueur de la ligne longueur = Cells(1, 253).Left - Cells(1, 2).Left
' Teste si l'index existe déjà. Dans ce cas, on l'efface. ' On utilise ici On Error Resume Next, qui permet de tester l'erreur On Error Resume Next ActiveSheet.Shapes("IndeX").Delete
' Ajoute une ligne en fonction des coordonnées précédemment calculées. ' La ligne est transparente, de grosseur 1 et de couleur rouge (10) ' On ne peut pas l'imprimer. ActiveSheet.Shapes.AddShape(msoShapeRectangle, PosHorizontal, PosHaut, longueur, 1).Name = "IndeX"
With ActiveSheet.Shapes("IndeX") .Fill.Visible = msoFalse .Fill.Transparency = 0# .Line.Weight = 1# .Line.ForeColor.SchemeColor = 10 .PrintObject = False End With
End Sub
-- ____ ( O | O ) -- _oooO_ JLuc _Oooo_
O-O
Zut, fausse manoeuvre :D
voilà le code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Largeur entre la cellule active et la première colonne
PosHorizontal = Cells(Target.Row, 2).Left
' Position verticale sur ligne 2 ou plus
PosHaut = Application.WorksheetFunction.Max((Cells(Target.Row, 2).Top +
(Cells(Target.Row, 2).Height / 2)), _
(Cells(2, 5).Top + (Cells(2, 5).Height / 2)))
' longueur de la ligne
longueur = Cells(1, 253).Left - Cells(1, 2).Left
' Teste si l'index existe déjà. Dans ce cas, on l'efface.
' On utilise ici On Error Resume Next, qui permet de tester l'erreur
On Error Resume Next
ActiveSheet.Shapes("IndeX").Delete
' Ajoute une ligne en fonction des coordonnées précédemment calculées.
' La ligne est transparente, de grosseur 1 et de couleur rouge (10)
' On ne peut pas l'imprimer.
ActiveSheet.Shapes.AddShape(msoShapeRectangle, PosHorizontal, PosHaut,
longueur, 1).Name = "IndeX"
With ActiveSheet.Shapes("IndeX")
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 1#
.Line.ForeColor.SchemeColor = 10
.PrintObject = False
End With
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Largeur entre la cellule active et la première colonne PosHorizontal = Cells(Target.Row, 2).Left
' Position verticale sur ligne 2 ou plus PosHaut = Application.WorksheetFunction.Max((Cells(Target.Row, 2).Top + (Cells(Target.Row, 2).Height / 2)), _ (Cells(2, 5).Top + (Cells(2, 5).Height / 2)))
' longueur de la ligne longueur = Cells(1, 253).Left - Cells(1, 2).Left
' Teste si l'index existe déjà. Dans ce cas, on l'efface. ' On utilise ici On Error Resume Next, qui permet de tester l'erreur On Error Resume Next ActiveSheet.Shapes("IndeX").Delete
' Ajoute une ligne en fonction des coordonnées précédemment calculées. ' La ligne est transparente, de grosseur 1 et de couleur rouge (10) ' On ne peut pas l'imprimer. ActiveSheet.Shapes.AddShape(msoShapeRectangle, PosHorizontal, PosHaut, longueur, 1).Name = "IndeX"
With ActiveSheet.Shapes("IndeX") .Fill.Visible = msoFalse .Fill.Transparency = 0# .Line.Weight = 1# .Line.ForeColor.SchemeColor = 10 .PrintObject = False End With
