Supprimer messages erreur (on error ne va pas)

H

herve80

XLDnaute Occasionnel
Bonjour,

Pour gagner du temps, j'ai fais une macro qui, avec F12, permet d'ouvrir la clé USB. Mais selon l'ordinateur, la clé est au chemin E, ou F, ou H, ...
Ce qui ouvre bien la clé USB, mais met une série de messages "Le chemin d'accès J (H,I, etc) n'existe pas ou n'est pas un répertoire."
Donc, ça fonctionne mais je perds du temps à effacer ces messages.
Comment ne plus les avoir ?

Ma macro :
Sub ouvrirclé()
On Error Resume Next
Shell "C:\WINNT\explorer.exe E:\", 1 ' adapter le chemin
Shell "c:\windows\explorer.exe F:", 1
Shell "c:\windows\explorer.exe H:", 1
Shell "c:\windows\explorer.exe I:", 1
Shell "c:\windows\explorer.exe J:", 1
End Sub

Merci de votre aide, bonne fin d'année à tous. ;)
 
Trier par date Trier par votes
H

herve80

XLDnaute Occasionnel
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : Supprimer messages erreur (on error ne va pas)

Re

Mais j'ai déjà remercié. Stp, pourrais-tu m'aider ?
Cliquez pour agrandir...

Excuse moi, mais j'avais point vu.

Le temps passe tellement vite, même gagner une micro-seconde chez moi, ça compte. Alors, comment empêcher ces messages d'erreurs ???
Cliquez pour agrandir...


La, je ne sais pas, mais attendons quelques secondes :).

Ce sujet m'intéresse en plus.

Bonnes fêtes.
 
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : Supprimer messages erreur (on error ne va pas)

RE


Bonjour Pierrot et merci :).

Sinon, je savais que je l'avais fait dans une appli pour connaître les lecteurs dispos (cela doit venir d'un code de MichelXLD je pense, ah et bien apparemment cela provient de 'Chip Pearson')

Voici le code

Code: 
Sub recherche_lecteurs_SurFeuille()
'code adapté par MJ issu de [URL]https://www.excel-downloads.com/threads/trouver-un-fichier-sur-le-pc.14470/[/URL]
Dim FSO As Object
Dim Drv As Object
Dim Msg$
Range("G2").Select
Set FSO = CreateObject("Scripting.FileSystemObject")
Msg = "Votre système a " & FSO.Drives.Count & " lecteurs :" & vbLf & vbLf
For Each Drv In FSO.Drives
With Drv
'Stop
Select Case .DriveType
Case 0 ' unknown
Msg = Msg & "Lecteur: " & .DriveLetter & " est de type inconnu." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "type inconnu"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 1 ' removable, e.g., zip
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque amovible." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque amovible"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 2 ' fixed, hard drive
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque dur." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque dur"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 3 ' remote
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque réseau." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque réseau"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 4 ' CDROM
Msg = Msg & "Lecteur: " & .DriveLetter & " est un CDROM." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "CDROM"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 5 ' ram disk
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque virtuel." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque virtuel"
 ActiveCell.Offset(1, -1).Range("A1").Select
End Select
End With
Next Drv
MsgBox Msg, , "Lecteurs du système"
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : Supprimer messages erreur (on error ne va pas)

Bonjour Hervé, Michel:)

Regarde le code ci-dessous si il peut t'aider, te renverras la lettre des disques amovibles sauf A et B :

Code: 
Sub test()
Dim fs As Object, d As Object, i As Byte
Set fs = CreateObject("Scripting.FileSystemObject")
For Each d In fs.drives
    If d.DriveLetter <> "A" And d.DriveLetter <> "B" And d.DriveType = 1 Then _
        MsgBox "un disque amovible dans le lecteur : " & d.DriveLetter
Next d
End Sub

bonne journée
@+
 
Vote positif 0 Vote négatif
H

herve80

XLDnaute Occasionnel
Re : Supprimer messages erreur (on error ne va pas)

Pierrot93 à dit:
Bonjour Hervé, Michel:)

Regarde le code ci-dessous si il peut t'aider, te renverras la lettre des disques amovibles sauf A et B :

Code: 
Sub test()
Dim fs As Object, d As Object, i As Byte
Set fs = CreateObject("Scripting.FileSystemObject")
For Each d In fs.drives
    If d.DriveLetter <> "A" And d.DriveLetter <> "B" And d.DriveType = 1 Then _
        MsgBox "un disque amovible dans le lecteur : " & d.DriveLetter
Next d
End Sub


bonne journée
@+
Cliquez pour agrandir...

Bonne année et merci. Ce n'est pas vraiment ce que j'avais demandé mais on s'en contentera.
Yesssssssssssssssssssssssss
:eek:
 
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : Supprimer messages erreur (on error ne va pas)

Bonjour,

alors pour répondre précisément à ta question : Perso, pas de solution...

sinon en modifiant le code donné ainsi :

Code: 
Option Explicit
Sub test()
Dim fs As Object, d As Object, l As String
Set fs = CreateObject("Scripting.FileSystemObject")
For Each d In fs.drives
    If d.DriveLetter <> "A" And d.DriveLetter <> "B" And d.DriveType = 1 Then
        l = d.DriveLetter
        Exit For
    End If
Next d
If l <> "" Then Shell "c:\windows\explorer.exe " & l & ":", 1
End Sub

tu évites de tester toutes les lettres et donc les messages intempestifs...

bonne journée
@+
 
Vote positif 0 Vote négatif
H

herve80

XLDnaute Occasionnel
Re : Supprimer messages erreur (on error ne va pas)

Pierrot93 à dit:
Bonjour,

alors pour répondre précisément à ta question : Perso, pas de solution...

sinon en modifiant le code donné ainsi :

Code: 
Option Explicit
Sub test()
Dim fs As Object, d As Object, l As String
Set fs = CreateObject("Scripting.FileSystemObject")
For Each d In fs.drives
    If d.DriveLetter <> "A" And d.DriveLetter <> "B" And d.DriveType = 1 Then
        l = d.DriveLetter
        Exit For
    End If
Next d
If l <> "" Then Shell "c:\windows\explorer.exe " & l & ":", 1
End Sub

tu évites de tester toutes les lettres et donc les messages intempestifs...

bonne journée
@+
Cliquez pour agrandir...

Bonjour,
Je vais encore t'embêter, mais et le code
Application.DisplayAlerts = False ?
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
Microsoft 365 Besoin aide : Erreur code macro . Problème est résolu
Réponses
7
Affichages
645
heart clean
H
M
  • Résolu(e)
XL 2021 Liste déroulante avec plusieurs conditions
Réponses
7
Affichages
272
MORAD AIT
M
patricktoulon
  • Résolu(e)
XL 2013 compilation ZIP gestion d'attente
Réponses
5
Affichages
456
cp4
cp4
M
  • Question
XL 2016 Instruction Cdate fait planter mon code
Réponses
3
Affichages
1 K
MONADESIGN82
M
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
R
  • Question
XL 2019 lister fichier avec exifs ou propriétés
Réponses
1
Affichages
1 K
fanch55
fanch55
C
  • Résolu(e)
Microsoft 365 Formule qui ralenti ma macro
2
Réponses
15
Affichages
3 K
mapomme
mapomme
L
  • Question
XL 2016 Problème aléatoire de range dans un userform
Réponses
3
Affichages
619
Laurent97310
L
C
  • Résolu(e)
Microsoft 365 TCD et données
Réponses
2
Affichages
997
Coralie01120
C
Fredox
  • Question
Supprimer lignes selon contenu cellule --> ne fonctionne pas sur 1 page /4
Réponses
1
Affichages
556
Fredox
Fredox

Membres actuellement en ligne

23 membres et 418 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 236
Messages
2 086 479
Membres
103 232
dernier inscrit
logan035