Discussion :

[talkk]

Bonjour,

J'ai un dossier qui contient un nombre important de fichier, je souhaite les imprimer et ensuite modifier le titre de ces fichiers.
J'aimerais donc, récupérer 1 à 1 les fichiers, les imprimer ensuite les renommer.

Comment puis-je procéder ?

[Daniel.C]

Bonjour,

Est-ce que ce sont uniquement des classeurs Excel ?

[EngueEngue]

A modifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Dim F As String  
F = Dir$("C:\tondossier\*.*") 
 Do Until F = ""   
'tuouvres ton fichier
'si c'est un excel:
Sheets("tonsheet").Select 
ActiveSheet.PrintOut from:=1, To:=1, Copies:=1, Collate:=True
nouvonom = "Salut.xls"
Name "C:\tondossier\" & F As "C:\tondossier\" & nouvonom
'sinon Daniel va t'aider :p
 F = Dir$  
Loop

[lelensois16]

Dans le cas ou si on a plusieurs fichiers différents (Word,excel,pdf ...) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
' adapted from Access 2003 VBA Programmer's Reference
Public Enum actionType
openfile
printfile
End Enum
 
 
Public Const SW_SHOWNORMAL As Long = 1
Public Declare 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
 
Function ExecuteFile(fileName As String, action As actionType)
' action can be either "Openfile" or "Printfile".
Dim sAction As String
Select Case action
Case 0
' openfile
sAction = "Open"
Case 1 ' printfile
sAction = "Print"
End Select
ShellExecute 0, sAction, fileName, vbNullString, "", SW_SHOWNORMAL
End Function
 
 
 
Public Sub listing(stRep As String)
 
 
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.File
Dim new_nom As String
Dim i As Integer: i = 0
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
If oFSO.FolderExists(stRep) Then
 For Each oFld In oFSO.GetFolder(stRep).Files
   i = i + 1
 
   ExecuteFile oFld.Path, printfile
    new_nom = InputBox(i & "- le nom remplacant le fichier '" & oFld.Name & "' est : ")
   oFld.Name = new_nom
 
 Next
End If
 
End Sub
 
Public Sub pgm_principal()
Call listing("C:\Users\MONTAGRO\Desktop\test")
End Sub

nécessite le Microsoft Scripting Runtime
J'ai utilisé une API trouvable ici http://www.jpsoftwaretech.com/open-o...-files-in-vba/
l'autre solution serait d'utiliser automation pour chaque type de fichier ...

[talkk]

My bad, ce ne sont que des fichiers .mht, fichier propre à IE.

J'imagine que ta boucle, Engue, fonctionne quand même , me trompe-je ?
En rajoutant l'ouverture de IE etc , bien évidemment ..

[lelensois16]

éxécute cette ligne ( par rapport à la macro précédente ) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Public Sub pgm_principal()
Call listing("C:\Users\MONTAGRO\Desktop\test")
End Sub

Le paramètre étant le chemin.
Ne fais pas attention à la fonction, il est assez complexe ( comme tous les fonctions API ... Copie tout le code dans un module et actives la référence Microsoft Scripting Runtime dans VBE>Outils>Références.

Sinon voir du coté de Microsoft HTML library.

[talkk]

holà,

voici le code que j'ai fais, me basant sur la boucle de EngueEngue.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub conversionpdf()
Dim IE, AncienNom As String, NewName As String
Dim eQuery As Long
 
Dim path As String, F As String
Dim fTime As Single
 
path = "C:\Documents and Settings\lcristante\Desktop\FEpdf\"
chem = "C:\Documents and Settings\lcristante\Desktop\fiche d'écart\"
F = Dir$("C:\Documents and Settings\lcristante\Desktop\fiche d'écart\*.mht")
 
 Do Until F = ""
 
 Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
 
    IE.navigate chem & F
 
TryAgain:
        'Wait for 2 seconds to let IE load the document
        fTime = Timer
        Do While fTime > Timer - 2
            DoEvents
        Loop
        eQuery = IE.QueryStatusWB(6)  'get print command status
        If eQuery And 2 Then
            IE.ExecWB 6, 2, "", ""   'Ok to Print? Then execute the Print (6) command, without displaying the print dialog (2)
            'Wait for 2 seconds while IE prints
            fTime = Timer
            Do While fTime > Timer - 2
                DoEvents
            Loop
        Else
            GoTo TryAgain
        End If
    NewName = Split(F, ".")(0)
    NewName = path & NewName & ".pdf"
    AncienNom = path & "fiche.pdf"
    If FichierExiste(AncienNom) Then Name AncienNom As NewName
 
 
 F = Dir$
Loop
 
 
End Sub
 
Function FichierExiste(NomFichier As String) As Boolean
    FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function

Le code fonctionne, mais ne fais qu'un tour de boucle...
Voyez vous un problème, une erreur qui m'aurait échapper?

Merci

[Invité]

moi je préfère:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 F = Dir$("C:\Documents and Settings\lcristante\Desktop\fiche d'écart\*.mht")
 
 While F <> ""
'Code
F = Dir$
Wend

[talkk]

Je viens d'essayer, même problème ..

[talkk]

J'ai contourner le problème en mettant le nom de mes fichiers dans un tableau excel et en faisant une boucle, seulement voilà, quand il s'agit de renommer les fichiers, celà se fait dans le désordre .. voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub conversionpdf()
Dim IE, AncienNom As String, NewName As String
Dim eQuery As Long, j As Long, lastrow As Long
 
Dim path As String, F As String
Dim fTime As Single
 
 
lastrow = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
path = "C:\Documents and Settings\lcristante\Desktop\FEpdf\"
chem = "C:\Documents and Settings\lcristante\Desktop\fiche d'écart\"
 
For j = 2 To lastrow
 
    F = Sheets("Feuil1").Cells(j, "b").Value
    F = F & ".mht"
 
 Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
 
    IE.navigate chem & F
 
TryAgain:
        'Wait for 2 seconds to let IE load the document
        fTime = Timer
        Do While fTime > Timer - 2
            DoEvents
        Loop
        eQuery = IE.QueryStatusWB(6)  'get print command status
        If eQuery And 2 Then
            IE.ExecWB 6, 2, "", ""   'Ok to Print? Then execute the Print (6) command, without displaying the print dialog (2)
            'Wait for 2 seconds while IE prints
            fTime = Timer
            Do While fTime > Timer - 2
                DoEvents
            Loop
        Else
            GoTo TryAgain
        End If
        IE.Quit
 
    NewName = Split(F, ".")(0)
    NewName = path & NewName & ".pdf"
    AncienNom = path & "fiche.pdf"
 
    While FichierExiste(AncienNom) = False
                Do While fTime > Timer - 5
                DoEvents
            Loop
    Wend
 
    If FichierExiste(AncienNom) Then
        Name AncienNom As NewName
    End If
 
 
Next j
 
 
End Sub
 
Function FichierExiste(NomFichier As String) As Boolean
    FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function

J'essaye de mettre des tempo pour attendre la création de mon .pdf pr ensuite le renommer , mais rien à faire, il passe au document suivant. Mes renommages sont faux à chaque fois ...

D'avance merci