Bonjour a tous , j'ai un code pour tester un chemin réseau. Il fonctionne bien. Mais cliquer sur un bouton a chaque fois pour savoir si c'est ok c'est pas terrible. Alors ma question est, à la place du message est il possible de colorier une ellipse en vert si ok et en rouge si pas bon. Merci pour votre aide.
VB:
Sub TesteCheminReseau()
Dim i, Chemin As String
Chemin = Range("D41").Value
On Error Resume Next
i = Dir(Chemin & "*.*")
If i = "" Then MsgBox "Ce chemin n'existe pas"
End Sub
Dans le fichier joint un essai avec un Nom : Chemin.Etat créé et modifié sur évènement Change de la feuille et deux possibilités, une par MFC et jeux d'icônes et l'autre par la police WebDings et une autre MFC. Je préfère cette dernière.
Ne pas oublier qu'un chemin quel qu’il soit peut être valide à un instant et non valide à un autre. Donc cette solution affiche la validité du chemin qu'aux moment ou une cellule change de valeur dans la feuille (On peut restreindre dans cet exemple, au changement de D4 uniquement)
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D4").Text <> "" Then
Application.Names.Add ("Chemin.Etat"), (Dir(Range("D4").Text & "\*.*") <> "") * -1
Else
Application.Names.Add ("Chemin.Etat"), 0
End If
End Sub
Bonjour Christ, Roblochon,
Juste un exemple pour colorer un shape, voir en PJ avec :
VB:
Sub ChangementCouleurShape()
Condition = [F1]
If Condition = 1 Then
ActiveSheet.Shapes("Ellipse 1").DrawingObject.Interior.Color = RGB(0, 255, 0)
[F1] = 0
Else
ActiveSheet.Shapes("Ellipse 1").DrawingObject.Interior.Color = RGB(255, 0, 0)
[F1] = 1
End If
End Sub
Bonjour et merci pour vos deux propositions, je retiendrais celle de Roblochon. Mais une petite question du coup j'ai trois lien a contrôler et j'ai essayer avec
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D38,D39,D41").Text <> "" Then
Application.Names.Add ("Chemin.Etat"), (Dir(Range("D38,D39dD41").Text & "\*.*") <> "") * -1
Else
Application.Names.Add ("Chemin.Etat"), 0
End If
End Sub
ca me change les 3
[U]sylvanu[/U] ta façon de faire m'a donnée des idées pour mon fichier. Une petite question ton bouton il vient d'Excel !! Merci
Re,
Vous faites Insertion/Formes et n'importe quelle forme.
Puis vous cliquez droit sur la forme et faites "Affecter une macro" et vous choisissez votre macro.
Ça marche aussi avec des images.
j'ai un chemin réseau du type \\Srvfichiersvjs007.toto.toto.toto\communication_v5$\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\ qui me fais planter le code
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D38").Text <> "" Then
Application.Names.Add ("Chemin.Etat"), (Dir(Range("D38").Text & "\*.*") <> "") * -1
Else
Application.Names.Add ("Chemin.Etat"), 0
End If
End Sub
est il possible de modifier ce code pour qu'il fonctionne également comme un chemin du type c:\Users\Christophe\Desktop\ Merci pour votre aide
De retour mais trop tard pour ce soir, je verrai demain si j'ai le temps. Mais pour trois chemins, il faudra trois noms et trois Applications.Names.Add.
Je ne vois pas de raison à l'échec d'un chemin tel que ; c:\Users\Christophe\Desktop\
ca plante sur un chemin du type
\\toto.toto.net\communication_v5$\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\
et justement pas sur c:\Users\Christophe\Desktop\
re
en faite ca plante pas ca ne trouve pas le chemin mais du coup le code plante. Serrait 'il possible alors de modifier ce code pour qu'il ne plante plus, et affiche 1 si ok et 0 si non ok
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D38").Text <> "" Then
Application.Names.Add ("Chemin.Etat"), (Dir(Range("D38").Text & "\*.*") <> "") * -1
Else
Application.Names.Add ("Chemin.Etat"), 0
End If
End Sub
je me suis inspire aussi de ce code mais qui plante aussi si le chemin qui n'existe pas
Code:
Public Function DossierExiste(MonDossier as String)
If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function
Sub TesteSiDossierExiste()
Dim MonDossier As String
MonDossier = Range("D38").Value
If DossierExiste(MonDossier) = True Then
Range("W38").Value = 1
Else
Range("W38").Value = 0
End If
End Sub
et celui-ci me fait planter Excel. je vous joint un extrait de mon fichier. Merci