Compilation Codes

Le 24/12/2023 à 01:30

Bonsoir à tous,

J'ai ce code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim ecran
 Set ecran = ActiveWindow.VisibleRange
 With ActiveSheet
 Shapes("Image A").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image A").Top = ecran.Top + 20
 Shapes("Image B").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image B").Top = ecran.Top + 125
 Shapes("Image C").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image C").Top = ecran.Top + 230
 Shapes("Image D").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image D").Top = ecran.Top + 335
 Shapes("Image E").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image E").Top = ecran.Top + 440
 Shapes("Image F").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image F").Top = ecran.Top + 545
 Shapes("Image G").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image G").Top = ecran.Top + 650
 Shapes("Image H").Left = ecran.Left + 2966 ' adapter le nom de l'image et les dimensions
 Shapes("Image H").Top = ecran.Top + 652
 Shapes("Rectangle I").Left = ecran.Left + 315 ' adapter le nom de l'image et les dimensions
 Shapes("Rectangle I").Top = ecran.Top + 10
 Shapes("Rectangle J").Left = ecran.Left + 315 ' adapter le nom de l'image et les dimensions
 Shapes("Rectangle J").Top = ecran.Top + 40

End With
End Sub

J'aimerais mettre en surbrillance la cellule sélectionnée avec ce code:

Option Explicit
Public rngOldCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If rngOldCell Is Nothing Then
        Set rngOldCell = Target
        Exit Sub
    End If

    ActiveCell.Select
    Selection.Interior.Color = RGB(117, 47, 217)
    rngOldCell.Interior.Pattern = xlNone

    Set rngOldCell = Target

End Sub

Mais il faut compiler ces 2 codes, et je ne sais pas.

Pour la surbrillance, il y a peut-être une autre solution qui consisterait à déplacer un rectangle sur la cellule sélectionnée, comme sur l'image.

untitled 3

Je vous remercie beaucoup pour votre aide, en vous souhaitant de bonnes fêtes à toutes et tous !!!

Le 24/12/2023 à 01:49

bonjour oNnO,

une combinaison des 2

on peut positionner vos shapes aussi dans une cellule spécifique, par exemple avec .shapes("Image A").top = .range("H61").top +1, etc

Option Explicit
Public rngOldCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

     With Target
          If Not rngOldCell Is Nothing Then rngOldCell.Interior.Pattern = xlNone
          .Interior.Color = RGB(117, 47, 217)
          Set rngOldCell = Target
     End With

     Dim ecran
     Set ecran = ActiveWindow.VisibleRange
     With ActiveSheet
          .Shapes("Image A").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image A").Top = ecran.Top + 20
          .Shapes("Image B").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image B").Top = ecran.Top + 125
          .Shapes("Image C").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image C").Top = ecran.Top + 230
          .Shapes("Image D").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image D").Top = ecran.Top + 335
          .Shapes("Image E").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image E").Top = ecran.Top + 440
          .Shapes("Image F").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image F").Top = ecran.Top + 545
          .Shapes("Image G").Left = ecran.Left + 2963     ' adapter le nom de l'image et les dimensions
          .Shapes("Image G").Top = ecran.Top + 650
          .Shapes("Image H").Left = ecran.Left + 2966     ' adapter le nom de l'image et les dimensions
          .Shapes("Image H").Top = ecran.Top + 652
          .Shapes("Rectangle I").Left = ecran.Left + 315     ' adapter le nom de l'image et les dimensions
          .Shapes("Rectangle I").Top = ecran.Top + 10
          .Shapes("Rectangle J").Left = ecran.Left + 315     ' adapter le nom de l'image et les dimensions
          .Shapes("Rectangle J").Top = ecran.Top + 40
     End With
End Sub
Le 24/12/2023 à 15:40

Bonjour BsAlv,

Merci beaucoup ! J'essaie de comprendre le VBA...

Mais quand je change de cellule, celle-ci perd sa couleur de remplissage et redevient blanche.

capture

Kézako ?

Merci beaucoup !

Le 24/12/2023 à 16:28

re,

que voulez-vous faire avec l'ancienne sélection ?

With Target
If Not rngOldCell Is Nothing Then rngOldCell.Interior.color = rgb(255,0,0) '>>>> l'ancien target devient rouge !
.Interior.Color = RGB(117, 47, 217)'>>>nouveau target, ce couleur
Set rngOldCell = Target
End With

Le 24/12/2023 à 17:49

Incroyable ! C'est exactement cela ! Merci beaucoup !

Juste une derniére chose. Comment exclure cette surbrillance à partir de la colonne R ?

Merci !

Rechercher des sujets similaires à "compilation codes"