Problème erreur 424 objet requis

Le 31/07/2016 à 19:54

Bonjour

Je viens vers vous car je me suis perdu et je ne trouve plus la solution.

J'ai créer un classeur excel il y a 2 ans tous fonctionnais tres bien.

Cette semaine j'ai effectuer des changements pour ajouter des infos depuis il ne fonctionne plus.

Lorsque je clique sur mon boutons pour faire apparaitre mon userform le message d'erreur 424 objet requis apparait.

Help je ne trouve pas la solution

Je vous note mon code ci-dessous car mon fichier est trop lourd.

merci par avance

Dim Lg As Single
Dim Ht As Single
Private Declare PtrSafe Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare PtrSafe Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare PtrSafe Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare PtrSafe Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Public LeTexte As String, LaCouleur As String
Dim v As Long

Private Sub telexploit_Click()
If mailexp.Value = "egs-gascogne-e-ae-armagnac@erdf-grdf.fr" Then
Fichier = "Q:\ATCF\PORTEFEUILLES\PTF MPS\MYCOM\exparmagnac.pdf"
ShellExecute 0, "", Fichier, "", "", 0
End If
If mailexp.Value = "egs-gascogne-e-ae-astarac@erdf-grdf.fr" Then
Fichier = "Q:\ATCF\PORTEFEUILLES\PTF MPS\MYCOM\expastarac.pdf"
ShellExecute 0, "", Fichier, "", "", 0
End If
If mailexp.Value = "egs-gascogne-e-ae-lomagne@erdf-grdf.fr" Then
Fichier = "Q:\ATCF\PORTEFEUILLES\PTF MPS\MYCOM\explomagne.pdf"
ShellExecute 0, "", Fichier, "", "", 0
End If

End Sub

'initialisation de la taille du formulaire'
Private Sub UserForm_Resize()
Dim RtL As Single, RtH As Single, Fini
    If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
    RtL = Me.Width / Lg
    RtH = Me.Height / Ht
    Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
End Sub

Private Sub userform_activate()
EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
Remplir Me.cdi, 1
Remplir Me.codepostal1, 3
Remplir Me.Choixcommune, 5

        Me.exceptionregie.Value = ""
        Me.insee.Value = ""
        Me.cdp.Value = ""
        Me.cable.Value = ""

        Me.centre.Value = ""
        Me.comm.Value = ""
        Me.moar.Value = ""
        Me.cpc.Value = ""
        Me.ccs.Value = ""

        Me.maitriseouvrage.Value = ""
        Me.urba.Value = ""
        Me.erdf1.Value = ""
        Me.er1.Value = ""
        Me.exp.Value = ""
        Me.Ent.Value = ""
        Me.CUTM.Value = ""
        Me.emmeraude.Value = ""
        Me.moreseau.Value = ""
        Me.CA.Value = ""
        Me.attention.Value = ""
        Me.commentaire.Value = ""
        Me.mailexp.Value = ""
        Me.telca.Value = ""
        Me.departement.Value = ""
        Me.moad.Value = ""
        Me.ceb.Value = ""
        Me.partraci.Value = ""
        Me.partracs.Value = ""
         Me.partracc.Value = ""
        Me.partmod.Value = ""
         Me.proraci.Value = ""
        Me.proracs.Value = ""
         Me.proracc.Value = ""
        Me.promod.Value = ""
        Me.zoneetude.Value = ""
        Me.mailmoar.Value = ""
        Me.appref.Value = ""
        Me.affairecom.Value = ""
        Me.telexp.Value = ""
        Me.IP.Value = ""
        Me.Mailip.Value = ""
        Me.Portip.Value = ""
        Me.Telip.Value = ""

 End Sub

'Utilisation du bouton reset'

Private Sub CommandButton1_Click()
Remplir Me.cdi, 1
Remplir Me.codepostal1, 3
Remplir Me.Choixcommune, 5

        Me.exceptionregie.Value = ""
        Me.insee.Value = ""
        Me.cdp.Value = ""
        Me.centre.Value = ""
        Me.comm.Value = ""
        Me.moar.Value = ""
        Me.cpc.Value = ""
        Me.ccs.Value = ""
        Me.maitriseouvrage.Value = ""
        Me.urba.Value = ""
        Me.erdf1.Value = ""
        Me.er1.Value = ""
        Me.exp.Value = ""
        Me.Ent.Value = ""
        Me.CUTM.Value = ""
        Me.emmeraude.Value = ""
        Me.moreseau.Value = ""
        Me.CA.Value = ""
        Me.attention.Value = ""
        Me.commentaire.Value = ""
        Me.mailexp.Value = ""
        Me.telca.Value = ""
        Me.departement.Value = ""
        Me.moad.Value = ""
         Me.ceb.Value = ""
         Me.partraci.Value = ""
         Me.partracs.Value = ""
          Me.partracc.Value = ""
        Me.partmod.Value = ""
        Me.proraci.Value = ""
        Me.proracs.Value = ""
         Me.proracc.Value = ""
        Me.promod.Value = ""
        Me.zoneetude.Value = ""
        Me.mailmoar.Value = ""
        Me.appref.Value = ""
        Me.affairecom.Value = ""
        Me.telexp.Value = ""
        Me.IP.Value = ""
        Me.Mailip.Value = ""
        Me.Portip.Value = ""
        Me.Telip.Value = ""

End Sub
'remise a zero du formulaire'
Private Sub Vider()
        Me.exceptionregie.Value = ""
        Me.insee.Value = ""
        Me.cdp.Value = ""
        Me.centre.Value = ""
        Me.comm.Value = ""
        Me.moar.Value = ""
        Me.cpc.Value = ""
        Me.ccs.Value = ""
        Me.maitriseouvrage.Value = ""
        Me.urba.Value = ""
        Me.erdf1.Value = ""
        Me.er1.Value = ""
        Me.exp.Value = ""
        Me.Ent.Value = ""
        Me.CUTM.Value = ""
        Me.emmeraude.Value = ""
        Me.moreseau.Value = ""
        Me.CA.Value = ""
        Me.attention.Value = ""
        Me.commentaire.Value = ""
        Me.mailexp.Value = ""
        Me.telca.Value = ""
        Me.departement.Value = ""
        Me.moad.Value = ""
         Me.ceb.Value = ""
         Me.partraci.Value = ""
         Me.partracs.Value = ""
         Me.partracc.Value = ""
        Me.partmod.Value = ""
        Me.proraci.Value = ""
        Me.proracs.Value = ""
         Me.proracc.Value = ""
        Me.promod.Value = ""
        Me.zoneetude.Value = ""
        Me.mailmoar.Value = ""
        Me.appref.Value = ""
        Me.affairecom.Value = ""
        Me.telexp.Value = ""
        Me.IP.Value = ""
        Me.Mailip.Value = ""
        Me.Portip.Value = ""
        Me.Telip.Value = ""

End Sub
'incrémentation des valeurs a chaque zone de texte dans le formulaire '
Private Sub Importer(ByVal Lig As Integer)

 Vider
If Lig > 0 Then
    With Worksheets("Communes dans PRAC_Global_2015")
        Me.exceptionregie.Value = .Range("AK" & Lig)
        Me.insee.Value = .Range("A" & Lig)
        Me.cdp.Value = .Range("C" & Lig)
        Me.centre.Value = .Range("D" & Lig)
        Me.comm.Value = .Range("E" & Lig)
        Me.moar.Value = .Range("F" & Lig)
        Me.cpc.Value = .Range("AP" & Lig)
        cpc.Value = Format(cpc.Value, "00"" ""00"" ""00"" ""00"" ""00")
        Me.ccs.Value = .Range("AO" & Lig)
        Me.maitriseouvrage.Value = .Range("L" & Lig)
        Me.urba.Value = .Range("P" & Lig)
        Me.erdf1.Value = .Range("AL" & Lig)
        Me.er1.Value = .Range("AM" & Lig)
        Me.exp.Value = .Range("AN" & Lig)
        Me.Ent.Value = .Range("W" & Lig)
        Me.CUTM.Value = .Range("J" & Lig)
        Me.emmeraude.Value = .Range("Q" & Lig)
        Me.moreseau.Value = .Range("K" & Lig)
        Me.CA.Value = .Range("X" & Lig)
        Me.attention.Value = .Range("AQ" & Lig)
        Me.mailexp.Value = .Range("AT" & Lig)
        Me.telca.Value = .Range("Y" & Lig)
        telca.Value = Format(telca.Value, "00"" ""00"" ""00"" ""00"" ""00")
      Me.departement.Value = .Range("H" & Lig)
        Me.moad.Value = .Range("AU" & Lig)
        Me.ceb.Value = .Range("U" & Lig)
        Me.partraci.Value = .Range("BB" & Lig)
        Me.partracs.Value = .Range("AV" & Lig)
        Me.partracc.Value = .Range("G" & Lig)
        Me.partmod.Value = .Range("G" & Lig)
        Me.proraci.Value = .Range("BB" & Lig)
        Me.proracs.Value = .Range("AV" & Lig)
         Me.proracc.Value = .Range("G" & Lig)
        Me.promod.Value = .Range("G" & Lig)
        Me.zoneetude.Value = .Range("AW" & Lig)
        Me.mailmoar.Value = .Range("AX" & Lig)
        Me.appref.Value = .Range("AY" & Lig)
        Me.affairecom.Value = .Range("AZ" & Lig)
        Me.telexp.Value = .Range("BA" & Lig)
        Me.IP.Value = .Range("BC" & Lig)
        Me.Mailip.Value = .Range("BD" & Lig)
       Me.Telip.Value = .Range("BD" & Lig)
    Me.Portip.Value = .Range("BE" & Lig)

       If maitriseouvrage.Value = "Régie" Then
       Me.commentaire.Value = .Range("AS" & Lig)
       Else
       Me.commentaire.Value = .Range("AR" & Lig)
       End If
        End With
End If
End Sub
' initialisation du formulaire '
Private Sub UserForm_Initialize()
Dim hWnd As Long

Remplir Me.cdi, 1
Remplir Me.codepostal1, 3
Remplir Me.Choixcommune, 5

LeTexte = "Le Bareme V4 est en route depuis le 8 octobre 2015 merci de verrifier l'emplacement de référence du coffret de viabilisation // Une modification d'adresse mail a été réalisé pour STE 49-50 et EXE 64-66 L'adresse mail est ERDF-DRMPS-GEPILHG@EDFGDF  // Pour les communes du secteur cablage+ 32 les mails Moar sont à envoyer à Toulouse et pas à St Girons.  "
v = 5: LaCouleur = "&H800001&": ParametresHtml

'couleur des fonds'
Métier.BackColor = RGB(255, 255, 255)
Rercherche.BackColor = RGB(255, 255, 255)
Infos.BackColor = RGB(255, 255, 255)
CONTACTS.BackColor = RGB(255, 255, 255)
Frame1.BackColor = RGB(255, 255, 255)
BRCHTAEROSOUT.BackColor = RGB(255, 255, 255)
Frame3.BackColor = RGB(255, 255, 255)
Frame4.BackColor = RGB(255, 255, 255)
Commune.BackColor = RGB(255, 255, 255)
Label4.BackColor = RGB(255, 255, 255)
Commune.BackColor = RGB(255, 255, 255)
Label4.BackColor = RGB(255, 255, 255)
Label20.BackColor = RGB(255, 255, 255)
Label17.BackColor = RGB(255, 255, 255)
Label19.BackColor = RGB(255, 255, 255)
Label29.BackColor = RGB(255, 255, 255)
Label52.BackColor = RGB(255, 255, 255)
Label34.BackColor = RGB(255, 255, 255)
Label39.BackColor = RGB(255, 255, 255)
Label53.BackColor = RGB(255, 255, 255)
Label50.BackColor = RGB(255, 255, 255)
Label42.BackColor = RGB(255, 255, 255)
Label43.BackColor = RGB(255, 255, 255)
Label44.BackColor = RGB(255, 255, 255)
Label45.BackColor = RGB(255, 255, 255)
Label46.BackColor = RGB(255, 255, 255)
Label47.BackColor = RGB(255, 255, 255)
Label48.BackColor = RGB(255, 255, 255)
Label49.BackColor = RGB(255, 255, 255)
Frame6.BackColor = RGB(255, 255, 255)
Frame7.BackColor = RGB(255, 255, 255)
Label13.BackColor = RGB(255, 255, 255)
codeinsee.BackColor = RGB(255, 255, 255)
Label15.BackColor = RGB(255, 255, 255)
Label31.BackColor = RGB(255, 255, 255)
Label32.BackColor = RGB(255, 255, 255)
Label11.BackColor = RGB(255, 255, 255)
dep.BackColor = RGB(255, 255, 255)
telcpc.BackColor = RGB(255, 255, 255)
Label22.BackColor = RGB(255, 255, 255)
Mail.BackColor = RGB(255, 255, 255)
Label40.BackColor = RGB(255, 255, 255)
Label41.BackColor = RGB(255, 255, 255)
Label28.BackColor = RGB(255, 255, 255)
Label33.BackColor = RGB(255, 255, 255)
Urbanisme.BackColor = RGB(255, 255, 255)
ERDF.BackColor = RGB(255, 255, 255)
Label35.BackColor = RGB(255, 255, 255)
Label36.BackColor = RGB(255, 255, 255)
ER.BackColor = RGB(255, 255, 255)
exception.BackColor = RGB(255, 255, 255)
Label1.BackColor = RGB(255, 255, 255)
Label2.BackColor = RGB(255, 255, 255)
Label3.BackColor = RGB(255, 255, 255)
Label23.BackColor = RGB(255, 255, 255)
Label26.BackColor = RGB(255, 255, 255)
Label37.BackColor = RGB(255, 255, 255)
Label38.BackColor = RGB(255, 255, 255)
Image2.BackColor = RGB(255, 255, 255)
'couleur des boutons '
CommandButton1.BackColor = RGB(0, 94, 184)
telexploit.BackColor = RGB(0, 94, 184)

 End Sub

Private Sub Remplir(ByVal LST As Object, ByVal Col As Integer, Optional ByVal Crit As String, Optional ByVal ColCrit As Integer)
Dim MonDico As New Scripting.Dictionary
Dim LastLig As Long, i As Long
Dim Ajout As Boolean
Dim Tmp As String

LST.Clear
With Worksheets("Communes dans PRAC_Global_2015")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastLig
        Ajout = Crit = "" Or .Cells(i, Application.Max(1, ColCrit)) = Crit
        If Ajout Then
            Tmp = .Cells(i, Col).Value
            If Not MonDico.Exists(Tmp) Then MonDico.Add Tmp, Tmp
        End If
    Next i
End With

If MonDico.Count >= 0 Then LST.List = MonDico.Keys
Set MonDico = Nothing
End Sub
 'initialisation de la zone de recherche'
Private Sub Choixcommune_Change()
Dim Lig As Long

If Me.Choixcommune.ListIndex > -1 Then
    Me.cdi.ListIndex = -1
    Lig = LaLigne(Me.Choixcommune, 5)
    Importer Lig
     Remplir Me.cdi, 1, Choixcommune, 5
End If

End Sub
  'initialisation de la zone de recherche'
Private Sub cdi_Change()
Dim Lig As Long

If Me.cdi.ListIndex > -1 Then
    Me.Choixcommune.ListIndex = -1
    Lig = LaLigne(Me.cdi, 1)
    Importer Lig
End If

End Sub
  'initialisation de la zone de recherche'
Private Sub codepostal1_Change()

Vider
If Me.codepostal1.ListIndex > -1 Then
    Remplir Me.Choixcommune, 5, Me.codepostal1, 3
    Remplir Me.cdi, 1, Me.codepostal1, 3
End If

End Sub

Private Function LaLigne(ByVal Tmp As String, ByVal Col As Integer) As Long
Dim c As Range

Set c = Worksheets("Communes dans PRAC_Global_2015").Columns(Col).Find(Tmp, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
    LaLigne = c.Row
    Set c = Nothing
End If
End Function

Private Sub attention_change()
If attention = ("!!! ATTENTION COMMUNE ER !!!") Then
attention.BackColor = &HFF&
Else
attention.BackColor = &HFFFFFF
End If
End Sub

Private Sub commentaire_change()
If commentaire = ("Attention anciennement commune ERDF") Or commentaire = ("Attention anciennement commune ER") Or commentaire = ("PARTIELLE") Then
commentaire.BackColor = &H80FF&

Else
commentaire.BackColor = &HFFFFFF
End If
If exceptionregie.Value = "" Then
exceptionregie.BackColor = &HFFFFFF

Else
exceptionregie.BackColor = &H80FF&

End If
End Sub

Private Sub maitriseouvrage_change()
If maitriseouvrage = ("Régie") Then
attention.Enabled = False
urba.Enabled = False
erdf1.Enabled = False
er1.Enabled = False
Else
attention.Enabled = True
urba.Enabled = True
erdf1.Enabled = True
er1.Enabled = True
End If
End Sub

Private Sub Image1_Click()
 Fichier = "http://www.erdf.fr/Accueil"
    ShellExecute 0, "", Fichier, "", "", 0

End Sub

Private Sub Image2_Click()
Fichier = "http://www.annuaire-mairie.fr/ville-" & comm & "-" & departement & ".html"
    ShellExecute 0, "", Fichier, "", "", 0

End Sub

Private Sub photo_Click()
If maitriseouvrage.Value = "ERDF" Then
lrdierdf.Show
End If
If maitriseouvrage.Value = "ER" Then
dierdf.Show
End If
End Sub

Sub urba_change()
If urba.Value = "OUI" Then
urba.BackColor = &HC000&
Else
urba.BackColor = &HFFFFFF
End If
If urba.Value = "NON" Then
urba.Enabled = False
End If
End Sub

Sub commandeetude_change()
If commandeetude.Value = "INEO" Then
commandeetude.BackColor = &HFFC0C0

End If
If commandeetude.Value = "" Then
commandeetude.BackColor = &HFFFFFF

End If

End Sub

Sub proracc_change()

If proracc.Value = "" Then
proracc.BackColor = &HFFFFFF

End If
If proracc.Value = "TGC" Then
proracc.BackColor = &H80FF80
End If

End Sub
Sub proraci_change()

If proraci.Value = "" Then
proraci.BackColor = &HFFFFFF

End If
If proraci.Value = "TGC" Then
proraci.BackColor = &H80FF80
End If

End Sub
Sub proracs_change()

If proracs.Value = "" Then
proracs.BackColor = &HFFFFFF

End If
If proracs.Value = "TGC" Then
proracs.BackColor = &H80FF80
End If

End Sub
Sub promod_change()

If promod.Value = "" Then
promod.BackColor = &HFFFFFF

End If
If promod.Value = "TGC" Then
promod.BackColor = &H80FF80
End If

End Sub
Sub partmod_change()

If partmod.Value = "" Then
partmod.BackColor = &HFFFFFF

End If
If partmod.Value = "TGC" Then
partmod.BackColor = &H80FF80
End If

End Sub

Sub partracc_change()

If partracc.Value = "" Then
partracc.BackColor = &HFFFFFF

End If
If partracc.Value = "TGC" Then
partracc.BackColor = &H80FF80
End If

End Sub
Sub partracs_change()

If partracs.Value = "" Then
partracs.BackColor = &HFFFFFF

End If
If partracs.Value = "TGC" Then
partracs.BackColor = &H80FF80
End If

End Sub
Sub partraci_change()

If partraci.Value = "" Then
partraci.BackColor = &HFFFFFF
End If

If partraci.Value = "TGC" Then
partraci.BackColor = &H80FF80
End If

End Sub
Sub zoneetude_change()
'zone étude A01_A02 Toulouse
If zoneetude.Value = "A01_A02 Toulouse" Then
zoneetude.BackColor = &HFFC0FF
End If

If zoneetude.Value = "A01_A02 Toulouse" Then
proracc.BackColor = &HFFC0FF
End If

If zoneetude.Value = "A01_A02 Toulouse" Then
promod.BackColor = &HFFC0FF
End If

If zoneetude.Value = "A01_A02 Toulouse" Then
partmod.BackColor = &HFFC0FF
End If

If zoneetude.Value = "A01_A02 Toulouse" Then
partracc.BackColor = &HFFC0FF
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A03 St-Jory" Then
zoneetude.BackColor = &H4080&
End If

If zoneetude.Value = "A03 St-Jory" Then
proracc.BackColor = &H4080&
End If

If zoneetude.Value = "A03 St-Jory" Then
promod.BackColor = &H4080&
End If

If zoneetude.Value = "A03 St-Jory" Then
partmod.BackColor = &H4080&
End If

If zoneetude.Value = "A03 St-Jory" Then
partracc.BackColor = &H4080&
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A04 Balma" Then
zoneetude.BackColor = &HFFFF&
End If

If zoneetude.Value = "A04 Balma" Then
proracc.BackColor = &HFFFF&
End If

If zoneetude.Value = "A04 Balma" Then
promod.BackColor = &HFFFF&
End If

If zoneetude.Value = "A04 Balma" Then
partmod.BackColor = &HFFFF&
End If

If zoneetude.Value = "A04 Balma" Then
partracc.BackColor = &HFFFF&
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A05 Colomiers" Then
zoneetude.BackColor = &HA53F70
End If

If zoneetude.Value = "A05 Colomiers" Then
proracc.BackColor = &HA53F70
End If

If zoneetude.Value = "A05 Colomiers" Then
promod.BackColor = &HA53F70
End If

If zoneetude.Value = "A05 Colomiers" Then
partmod.BackColor = &HA53F70
End If

If zoneetude.Value = "A05 Colomiers" Then
partracc.BackColor = &HA53F70
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A06 Villemur" Then
zoneetude.BackColor = &H8111D2
End If

If zoneetude.Value = "A06 Villemur" Then
proracc.BackColor = &H8111D2
End If

If zoneetude.Value = "A06 Villemur" Then
promod.BackColor = &H8111D2
End If

If zoneetude.Value = "A06 Villemur" Then
partmod.BackColor = &H8111D2
End If

If zoneetude.Value = "A06 Villemur" Then
partracc.BackColor = &H8111D2
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A07 Caraman" Then
zoneetude.BackColor = &HEF3829
End If

If zoneetude.Value = "A07 Caraman" Then
proracc.BackColor = &HEF3829
End If

If zoneetude.Value = "A07 Caraman" Then
promod.BackColor = &HEF3829
End If

If zoneetude.Value = "A07 Caraman" Then
partmod.BackColor = &HEF3829
End If

If zoneetude.Value = "A07 Caraman" Then
partracc.BackColor = &HEF3829
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A08 Grenade" Then
zoneetude.BackColor = &H9AC7B9
End If

If zoneetude.Value = "A08 Grenade" Then
proracc.BackColor = &H9AC7B9
End If

If zoneetude.Value = "A08 Grenade" Then
promod.BackColor = &H9AC7B9
End If

If zoneetude.Value = "A08 Grenade" Then
partmod.BackColor = &H9AC7B9
End If

If zoneetude.Value = "A08 Grenade" Then
partracc.BackColor = &H9AC7B9
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A09 St-Lys" Then
zoneetude.BackColor = &H80FF&
End If

If zoneetude.Value = "A09 St-Lys" Then
proracc.BackColor = &H80FF&
End If

If zoneetude.Value = "A09 St-Lys" Then
promod.BackColor = &H80FF&
End If

If zoneetude.Value = "A09 St-Lys" Then
partmod.BackColor = &H80FF&
End If

If zoneetude.Value = "A09 St-Lys" Then
partracc.BackColor = &H80FF&
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A10 Muret" Then
zoneetude.BackColor = &H8000&
End If

If zoneetude.Value = "A10 Muret" Then
proracc.BackColor = &H8000&
End If

If zoneetude.Value = "A10 Muret" Then
promod.BackColor = &H8000&
End If
If zoneetude.Value = "A10 Muret" Then
partmod.BackColor = &H8000&
End If
If zoneetude.Value = "A10 Muret" Then
partracc.BackColor = &H8000&
End If
'zone étude A03 St-Jory
If zoneetude.Value = "A11 Auterive" Then
zoneetude.BackColor = &HFFFF00
End If

If zoneetude.Value = "A11 Auterive" Then
proracc.BackColor = &HFFFF00
End If

If zoneetude.Value = "A11 Auterive" Then
promod.BackColor = &HFFFF00
End If

If zoneetude.Value = "A11 Auterive" Then
partmod.BackColor = &HFFFF00
End If

If zoneetude.Value = "A11 Auterive" Then
partracc.BackColor = &HFFFF00
End If

'zone étude A03 St-Jory
If zoneetude.Value = "A12 Villefranche" Then
zoneetude.BackColor = &H133EBD
End If

If zoneetude.Value = "A12 Villefranche" Then
proracc.BackColor = &H133EBD
End If

If zoneetude.Value = "A12 Villefranche" Then
promod.BackColor = &H133EBD
End If

If zoneetude.Value = "A12 Villefranche" Then
partmod.BackColor = &H133EBD
End If

If zoneetude.Value = "A12 Villefranche" Then
partracc.BackColor = &H133EBD
End If

'zone étude A03 St-Jory
If zoneetude.Value = "" Then
zoneetude.BackColor = &HFFFFFF
End If

If zoneetude.Value = "" Then
proracc.BackColor = &HFFFFFF
End If

If zoneetude.Value = "" Then
promod.BackColor = &HFFFFFF
End If

If zoneetude.Value = "" Then
partmod.BackColor = &HFFFFFF
End If

If zoneetude.Value = "" Then
partracc.BackColor = &HFFFFFF
End If

End Sub

Sub ParametresHtml()
MYCOM.IMPORTANT.Navigate _
"about:<html><body BGCOLOR ='#CCE821' scroll='no'><font color= " & LaCouleur & _
" size='4' face='arial'><body topmargin='0'>" & _
"<marquee scrollamount=" & v & ">" & LeTexte & "</marquee></font></body><center></html>"
End Sub

Private Sub carte_Click()
carto.Show

End Sub
Le 01/08/2016 à 08:49

Bonjour Zimtab le forum

hélas avec seulement la macro on ne pourras pas vérifier

tu peux joindre ton fichier en le mettant sur cjoint.com et dans le post tu mets le lien que tu auras généré

a+

Papou

Le 01/08/2016 à 11:27

Rebonjour,

Voila j'ai suivis vos instructions le fichier se trouve https://www.cjoint.com/c/FHbjAmeymp3 .

En espérant que vous trouverez une réponse car je bloque.

Cordialement

Rechercher des sujets similaires à "probleme erreur 424 objet requis"