Imprimer tous les fichiers d'un dossier
pyhrrus1
Messages postés
7
Date d'inscription
lundi 5 avril 2004
Statut
Membre
Dernière intervention
23 novembre 2005
-
2 mai 2005 à 09:16
cs_chat84 Messages postés 5 Date d'inscription mardi 21 mars 2006 Statut Membre Dernière intervention 1 juin 2006 - 12 mai 2006 à 11:42
cs_chat84 Messages postés 5 Date d'inscription mardi 21 mars 2006 Statut Membre Dernière intervention 1 juin 2006 - 12 mai 2006 à 11:42
2 réponses
badboy38
Messages postés
95
Date d'inscription
vendredi 14 janvier 2005
Statut
Membre
Dernière intervention
4 mars 2013
2 mai 2005 à 19:09
2 mai 2005 à 19:09
Salut,
Avec dans une form: une imagebox, un bouton et un dirlistbox, tu peux utiliser ce code:
Private Sub Form_Load()
Image1.Visible = False
End Sub
Private Sub Command1_Click()
Dim b As String
Dim Fic As String
Dim h As Integer
Dim w As Integer
Dim fso, r
'on créé un fichier .txt avec tous les noms de fichiers du dossier
Open Dir1 + "\a.txt" For Output As #1
Fic = ""
Fic = Dir(Dir1 + "\*.*")
If Fic = "" Then
MsgBox "Pas de Fichers trouvés", vbOKOnly + vbExclamation
Close #1
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\a.txt")
Exit Sub 'sort de la Sub, attention!
Else
Print #1, Fic
While Fic <> ""
Fic = Dir
Print #1, Fic
Wend
Close #1
'on trie les images....
Open Dir1 + "\a.txt" For Input As #2
Open Dir1 + "\b.txt" For Output As #3
Do Until EOF(2)
Line Input #2, b
If InStr(b, ".jpg") Or InStr(b, ".bmp") Then 'tu peux continuer
si il peut y avoir d'autres formats attention aux extensions en
majuscules!!! et ca ne marche pas avec les gifs!!!
Print #3, b
End If
Loop
Close #2
Close #3
End If
'et on imprime
Form1.BackColor = vbWhite
Image1.Top = 90
Image1.Left = 90
Image1.Visible = True
Dir1.Visible = False
Command1.Visible = False
Open Dir1 + "\b.txt" For Input As #4
Do Until EOF(4)
Line Input #4, b
If b <> "" Then
Image1.Picture = LoadPicture(Dir1 + "" + b)
Form1.Height = Image1.Height + 150
Form1.Width = Image1.Width + 150
PrintForm 'imprime la form courante (ici avec l'image)
End If
Loop
Form1.BackColor = &H8000000F
Dir1.Visible = True
Command1.Visible = True
Image1.Visible = False
MsgBox "Fini!", vbOKOnly + vbExclamation
Close #4
'on supprime les fichiers créés
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\a.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\b.txt")
Unload Me
End
End Sub
son seul problème, c'est que tu ne peux pas
imprimer les gifs, et qu'il faut écrire toutes le extensions possibles
en minuscules ET majuscules... je m'excuse de cet inconvénient (je
débute en VB) mais j'espère que ça t'aidera!
BadBoy38
P.S. je l'ai testé, ce code marche... du moins avec des .bmp et .jpg
Avec dans une form: une imagebox, un bouton et un dirlistbox, tu peux utiliser ce code:
Private Sub Form_Load()
Image1.Visible = False
End Sub
Private Sub Command1_Click()
Dim b As String
Dim Fic As String
Dim h As Integer
Dim w As Integer
Dim fso, r
'on créé un fichier .txt avec tous les noms de fichiers du dossier
Open Dir1 + "\a.txt" For Output As #1
Fic = ""
Fic = Dir(Dir1 + "\*.*")
If Fic = "" Then
MsgBox "Pas de Fichers trouvés", vbOKOnly + vbExclamation
Close #1
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\a.txt")
Exit Sub 'sort de la Sub, attention!
Else
Print #1, Fic
While Fic <> ""
Fic = Dir
Print #1, Fic
Wend
Close #1
'on trie les images....
Open Dir1 + "\a.txt" For Input As #2
Open Dir1 + "\b.txt" For Output As #3
Do Until EOF(2)
Line Input #2, b
If InStr(b, ".jpg") Or InStr(b, ".bmp") Then 'tu peux continuer
si il peut y avoir d'autres formats attention aux extensions en
majuscules!!! et ca ne marche pas avec les gifs!!!
Print #3, b
End If
Loop
Close #2
Close #3
End If
'et on imprime
Form1.BackColor = vbWhite
Image1.Top = 90
Image1.Left = 90
Image1.Visible = True
Dir1.Visible = False
Command1.Visible = False
Open Dir1 + "\b.txt" For Input As #4
Do Until EOF(4)
Line Input #4, b
If b <> "" Then
Image1.Picture = LoadPicture(Dir1 + "" + b)
Form1.Height = Image1.Height + 150
Form1.Width = Image1.Width + 150
PrintForm 'imprime la form courante (ici avec l'image)
End If
Loop
Form1.BackColor = &H8000000F
Dir1.Visible = True
Command1.Visible = True
Image1.Visible = False
MsgBox "Fini!", vbOKOnly + vbExclamation
Close #4
'on supprime les fichiers créés
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\a.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
r = fso.DeleteFile(Dir1 & "\b.txt")
Unload Me
End
End Sub
son seul problème, c'est que tu ne peux pas
imprimer les gifs, et qu'il faut écrire toutes le extensions possibles
en minuscules ET majuscules... je m'excuse de cet inconvénient (je
débute en VB) mais j'espère que ça t'aidera!
BadBoy38
P.S. je l'ai testé, ce code marche... du moins avec des .bmp et .jpg
cs_chat84
Messages postés
5
Date d'inscription
mardi 21 mars 2006
Statut
Membre
Dernière intervention
1 juin 2006
12 mai 2006 à 11:42
12 mai 2006 à 11:42
Bonjour, si je veux utiliser ce code avec un lien fixe, que dois-je changer ?
Merci
Merci
