Macro carte des départements

rebonjour !

merci a banzaï qui m'a bien aidé à avancer

j'ai juste une question sur ce code

je voudrais supprimer la macro du département 20 elle ne m'est pas utile et me bloque dans mes menus déroulants

si je la supprime il ya une erreur dans le code ci dessous,

excusé le novice que je suis!!!

Sub Evt_Dpt_Sel(NoDpt As Integer)

Dim DptRow As Range

Dim DptRgn As Range

Set DptRow = Dpt_Find(, NoDpt)

If DptRow Is Nothing Then

MsgBox "Erreur : Département " & NoDpt & " non recensé en table"

Exit Sub

End If

Set RgnRow = Rgn_Find(DptRow.Cells(1, 4))

If RgnRow Is Nothing Then

MsgBox "Erreur : Région " & DptRow.Cells(1, 4) & " non recensée en table"

Exit Sub

End If

For Each Row In Sheets("Départements").Range("Table_Départements").Rows

If Row.Cells(1, 4).Value = DptRow.Cells(1, 4).Value Then

If Row.Cells(1, 2).Value = DptRow.Cells(1, 2).Value Then

Sheets("France").Shapes(Row.Cells(1, 1)).Fill.ForeColor.RGB = _

Sheets("France").Shapes("CouleurDépartement").Fill.ForeColor.RGB

Sht_Fra.Cbx_Dpt.Text = Sht_Fra.Cbx_Dpt.List(DptRow.Row - 3)

Else

Sheets("France").Shapes(Row.Cells(1, 1)).Fill.ForeColor.RGB = _

Sheets("France").Shapes("CouleurRégion").Fill.ForeColor.RGB

Sht_Fra.Cbx_Rgn.Text = Sht_Fra.Cbx_Rgn.List(RgnRow.Row - 3)

End If

Else

If Row.Cells(1, 1).Value <> "Dpt20" Then _

Sheets("France").Shapes(Row.Cells(1, 1)).Fill.ForeColor.RGB = _

Sheets("France").Shapes("CouleurFrance").Fill.ForeColor.RGB

End If

Next Row

End Sub

Bonjour

Le fichier vient de :

https://forum.excel-pratique.com/excel/carte-de-la-france-interactive-et-modulable-t23198.html

Tu as aussi supprimé la région ?

Remplaces les deux macros dans la feuille "France"

Private Sub Cbx_Dpt_Click()
  Evt_Dpt_Sel (Cbx_Dpt.ListIndex + 1) + Abs((Cbx_Dpt.ListIndex) > 18)
End Sub

Private Sub Cbx_Rgn_Click()
  For Each Row In Sheets("Départements").Range("Table_Départements").Rows
    If Int(Row.Cells(1, 4).Value) = Cbx_Rgn.ListIndex + 1 + Abs((Cbx_Rgn.ListIndex) > 7) Then
      Evt_Dpt_Sel (Int(Row.Cells(1, 2).Value))
      Exit For
    End If
  Next Row
End Sub

C'est une solution : Pas la solution