Imprimer toutes les images d'un dossier [Résolu]

cs_chat84 5 Messages postés mardi 21 mars 2006Date d'inscription 1 juin 2006 Dernière intervention - 19 mai 2006 à 09:27 - Dernière réponse : cs_chat84 5 Messages postés mardi 21 mars 2006Date d'inscription 1 juin 2006 Dernière intervention
- 19 mai 2006 à 13:28
Bonjour à tous, j'ai adapté un code que j'ai trouvé sur le forum pour imprimer toutes les images d'un dossier.

Si les images dans "C:\images" ca marche mais dès que l'arborescence est longue comme par exemple: "C:\images\New Folder\New Folder\New Folder\New" Folder, je recoit un message d'erreur de Photo Editor qui dit "format de fichier incunnu".

Est-ce que quelqu'un saurait ce qui pose problème? Merci

Sub IMPRIME_TOUT_click()
'
' Macro1 Macro
' Macro enregistrée le 19/07/2004 par supervisor
'
Dim rep As String
Dim enuma As Integer
enuma = 0
exitall = False

'On demande à l'utilisateur l'emplacement du dossier
dossier = "C:\mes images"
'petites vérif sur le dossier
If Len(dossier) > 3 Then
dossier = dossier & ""
End If
If dossier = "" Then
MsgBox "Pas de dossier sélectionné"
Exit Sub
End If

'obtient le premier fichier ou répertoire qui est dans "c:"
rep = Dir(dossier)
'MsgBox rep
'boucle tant que le répertoire n'a pas été entièrement parcouru
Do While (rep <> "")

'teste si c'est un fichier ou un répertoire
If (GetAttr(dossier & rep) And vbDirectory) = vbDirectory Then '

' on pourrait faire un truc si c un dossier
'sinon c un fichier et on vérifie si c un doc
ElseIf (Right$(rep, 4) = ".jpg") Then
'on envoi à l'impression
'Shell ("C:\WINNT\system32\mspaint.exe /p " & dossier & rep)
Shell ("C:\Program Files\Common Files\Microsoft Shared\PhotoEd\PHOTOED.EXE /p " & dossier & rep)
'on compte combien d'impression l'on fait
enuma = enuma + 1
End If

'Else: MsgBox Dossier & rep
'passe à l'élément suivant
rep = Dir
Loop

'Si il y a rien d'imprimer on le dit
If enuma = 0 Then

MsgBox "RIEN A IMPRIMER DANS" & rep
Exit Sub
End If

MsgBox enuma & " photos trouvées et imprimées"
End Sub

<!-- / message -->
Afficher la suite 

Votre réponse

2 réponses

Meilleure réponse
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 19 mai 2006 à 12:50
3
Merci
 Bonjour à tous....

Peut-être en utilisant le chemin dos (répertoire et fichier).

Dim fso, path, fichier, fichiers
path = "E:\Affaires\EUROFACTOR - AP02N008\4.3 Formulaires\Formulaires spécifiques"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(path)
Set fichiers = Dossier.Files

For Each fichier in fichiers
MsgBox "shortPath=" & fichier.ShortPath & vbCrLf & "Path=" & fichier.Path
MsgBox "shortName=" & fichier.ShortName & vbCrLf & "Name=" & fichier.Name
Next
Set fso = Nothing
Set dossier = Nothing
Set fichiers = Nothing

jean-marc

Merci cs_JMO 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 96 internautes ce mois-ci

Commenter la réponse de cs_JMO
cs_chat84 5 Messages postés mardi 21 mars 2006Date d'inscription 1 juin 2006 Dernière intervention - 19 mai 2006 à 13:28
0
Merci
Merci beaucoup pour ton code, ca marche à merveille en mettant le shortpath dans la fonction shell!

Dim fso, path, fichier, fichiers
path = "C:\images\New Folder\New Folder\New Folder\New Folder"
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(path)
Set fichiers = dossier.Files


For Each fichier In fichiers
Shell ("C:\Program Files\Common Files\Microsoft Shared\PhotoEd\PHOTOED.EXE /p " & fichier.shortpath)


'MsgBox "shortPath=" & fichier.shortpath & vbCrLf & "Path=" & fichier.path
'MsgBox "shortName=" & fichier.ShortName & vbCrLf & "Name=" & fichier.Name
Next
Set fso = Nothing
Set dossier = Nothing
Set fichiers = Nothing
Commenter la réponse de cs_chat84

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.