Mise en forme d'une feuille avec visuels

Résolu
bonjour,

Voici mon souci, je réalise un cahier de maintenance celui ci a bien pris forme et arrive bientôt au terme. (enfin presque...)

voici le visuel de la feuille ou je rencontre des problèmes.

Alors il y a 2 choses qui ne vont pas :

la première est que ma cellule qui déclenche mes visuels reste active quand je sort de la feuille d'où quand je reviens sur ma feuille je n'ai pas de réinit. de mes visuels

il faudrait que quand je quitte ma feuille ma cellule sélectionnée aille sur une cellule qui ne déclenche rien comme ça mes visuels s'effacent.

La deuxième choses est que dans la cellule I5 j'ai le titre affiché en A47 quand je sélectionne mes cellules G50,G51,G52....

idem pour les autres titres en bleu ex. : CAPTEUR DE CHLORE la cellule I5 me renvoie I25 quand je sélectionne I26

ci joint le bout de programme me permettant les manip.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("Documentations").Select
Feuil3.Document1.Picture = LoadPicture("")
Feuil3.Document2.Picture = LoadPicture("")

If Not Intersect(Target, Range("a38")) Is Nothing Then
Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\ReseauVPN.jpg")
ActiveWindow.ScrollRow = 8
End If

If Not Intersect(Target, Range("a39")) Is Nothing Then
Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\LiaisonRS232.jpg")
ActiveWindow.ScrollRow = 8
End If

If Not Intersect(Target, Range("g48")) Is Nothing Then
Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\Concentrateurs_CCC.jpg")
ActiveWindow.ScrollRow = 8
End If

If Not Intersect(Target, Range("g50")) Is Nothing Then
Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\CC01_Montmartre.jpg")
Feuil3.Document2.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\CC01b_Montmartre.jpg")
ActiveWindow.ScrollRow = 8
End If

Etc ...

Merci,

5 réponses

  1. Bonjour ,

    En fait pour faire au plus simple dans mes explications ci joint le fichier test.
    Espérant que ma demande soit plus compréhensible
    Cdt,
    0
    1. Bonjour,

      Pour la première question:
      Ajoutez la cellule à sélectionner en fin de macro
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          Application.EnableEvents = False
          Sheets("Documentations").Select
          Feuil3.Document1.Picture = LoadPicture("")
          Feuil3.Document2.Picture = LoadPicture("")
          
          If Not Intersect(Target, Range("a38")) Is Nothing Then
              Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\ReseauVPN.jpg")
              ActiveWindow.ScrollRow = 8
          End If
          
          If Not Intersect(Target, Range("a39")) Is Nothing Then
              Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\LiaisonRS232.jpg")
              ActiveWindow.ScrollRow = 8
          End If
          
          If Not Intersect(Target, Range("g48")) Is Nothing Then
              Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\Concentrateurs_CCC.jpg")
              ActiveWindow.ScrollRow = 8
          End If
          
          If Not Intersect(Target, Range("g50")) Is Nothing Then
              Feuil3.Document1.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\CC01_Montmartre.jpg")
              Feuil3.Document2.Picture = LoadPicture("F:\01_DD\01_R&I\01_A-INSTALL\01_P&P\04_Sup_tech\03 - Cahier de maintenance\Docs\CC01b_Montmartre.jpg")
              ActiveWindow.ScrollRow = 8
          End If
          
          Range("A1").Select
          Application.EnableEvents = True
      End Sub
      


      Pour la 2ème , pas compris.

      Où est le fichier?

      Cdlt
      0
      1. Ceci:

        Private Sub Worksheet_SelectionChange(ByVal Target As Range)
            If Not Intersect(Target, Range("C15:C17")) Is Nothing Then
                Range("D10").Value = Range("C14").Value
            ElseIf Not Intersect(Target, Range("C20:C22")) Is Nothing Then
                Range("D10").Value = Range("C19").Value
            End If
        End Sub
        0
        1. En fait pour la première question j'ai ajouter à mon bouton "documentation""

          Sub Documentations()
          '
          ' Documentations Macro
          '

          '
          Sheets("Documentations").Select
          ActiveWindow.ScrollRow = 52
          ActiveWindow.ScrollRow = 8
          Range("A1").Select
          End Sub
          0