macro cartographie infos

Question

Bonjour,

J'ai créé une macro sous Excel qui va me servir à aller chercher des infos dans une autre feuille de mon classeur.

Deux problèmes apparaissent:
Impossible de définir la propriéte ColorIndex de la classe Font
pointage au niveau de: ActiveCell.Font.ColorIndex =  7

et Val1 = Left(ActiveCell.Value, 4) est une variable non défine

Je suis vraiment bloqué
Pouvez-vous m'aider svp?

Merci d'avance

Ci-dessous le code sous VB

Option Explicit


Public Intitulé As String, Adrs As String, AdrNum As String




Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell.Value <> Empty Then
   If Not Intersect(Range("D10:AD18"), Target) Is Nothing Then 'selection du tableau
      Call RechercheInfo
      Call MakePopup
      CommandBars("Data Popup").ShowPopup
      Cancel = True
   End If
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("D10:AD18"), Target) Is Nothing Then
      Call Affiche_Infos
   End If
  
End Sub




Sub MakePopup()


   On Error Resume Next
   CommandBars("Data Popup").Delete
   On Error GoTo 0
   With CommandBars.Add(Name:="Data Popup", Position:=msoBarPopup)
      With .Controls.Add(Type:=msoControlButton)
         .OnAction = "SelectMasque"
         .FaceId = 264
         .Caption = Intitulé & " - Poste:" & AdrNum
         .TooltipText = Intitulé
      End With
   End With
End Sub




Sub RechercheInfo()
 Val1 = Left(ActiveCell.Value, 4) 
Set Ligne1  = FListe.Range("S2:S500").Find(What:= Val1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    Intitulé = FListe.Cells(Ligne1.Row, 5)
    Adrs = FListe.Cells(Ligne1.Row, 8)
    AdrNum = Ligne1.Offset(0, -5)
End Sub

Sub Affiche_Infos()


Dim Texte1 As String, Texte2 As String, Texte3 As String, Texte4 As String, Texte5 As String, Texte6 As String, Texte7 As String, Texte8 As String, Texte9 As String, Texte10 As String, Texte11 As String, Texte12 As String, Texteplus As String
RTexte = Right(ActiveCell.Value, 6)


'Sheets("Inventaire").Select
'Range("S5:S500").Select
    
With Sheets("Inventaire").Range("S5:S500")


    Set c = .Find(RTexte, LookIn:=xlValues)
        If Not c Is Nothing Then
        Texte1 = c.Offset(0, -16)
        Texte2 = c.Offset(0, -15)
        Texte3 = c.Offset(0, -14)
        Texte4 = c.Offset(0, -13)
        Texte5 = c.Offset(0, -11)
        Texte6 = c.Offset(0, -10)
        Texte7 = c.Offset(0, -7)
        Texte8 = c.Offset(0, -9)
        Texte9 = c.Offset(0, -6)
        Texte10 = c.Offset(0, 2)
        Texte11 = c.Offset(0, 1)
        Texte12 = c.Offset(0, -1)
         ActiveCell.Font.ColorIndex = 7 
        Texteplus  = " - "
        End If
End With




With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = "Moyen de traçabilité"
        .ErrorTitle = ""
        .InputMessage = Texte1 & Texteplus & Texte2 & " - Type matériel:" & Texte3 & Texteplus & Texte4 & " - n°:" & Texte5 & " - Date:" & Texte6 & " - Garantie:" & Texte7 & " - Marque:" & Texte8 & " -- Modèle:" & Texte9 & Texteplus & Texte10 & Texteplus & Texte11 & " - Jalon:" & Texte12
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

ptitb74 · Answer

J'ai oublié de préciser que pour la cartographie, il y a plusieurs couleurs differnts (peut jouer sur IndexColor)

Merci

Macro cartographie infos

1 réponse

Votre réponse

Discussions similaires