Nommer un fichier aléatoirement

Version imprimable

07/08/2017, 15h10
Snake38

Nommer un fichier aléatoirement
Bonjour,

Voilà je pense que ma requête est assez simple, mais je n'y parviens pas.

Dans Powerpoint (2007), j'ai une macro qui enregistre la slide actuelle, sur le bureau en PNG :
Code:

1 2 3 4 5 6 Sub Commentez() ActivePresentation.Slides(1).Export _ FileName:="C:\Users\Thibault\Desktop\1.png", FilterName:="PNG" End Sub
Ca fonctionne très bien, sauf que je ne veux pas que mon fichier final s'appelle 1. Je veux qu'il soit composé de 6 chiffres aléatoires.
Mon but est d'enregistrer des fichiers ayant des noms tels que 465973, 179442...

Pouvez-vous m'aider svp ?

Un grand merci !

Salut

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim NonAleaFichier
 
function CreatNomFichier()
dim T
Randomize
 
for T = 0 to 5
        CreatNomFichier = CreatNomFichier & cstr(Int((9 * Rnd) + 1))
next
CreatNomFichier = CreatNomFichier & ".PNG"
end function
 
NonAleaFichier = CreatNomFichier
msgbox NonAleaFichier

Reste à vérifier si ce non de fichier n'existe pas avant de l'utiliser.

07/08/2017, 15h58
Snake38

Hey merci ! Ca m'a l'air super ! Tu peux juste me dire comment je combine ton code au mien ? J'y arrive pas !
Parce que ton code tout seul ne fonctionne pas !

Citation:

Parce que ton code tout seul ne fonctionne pas !

:calim2: je comprend pas ce que tu veux dire par là, ce qui est sûr c'est que le code proposé ne fait qu'afficher un nom de fichier composé de 6 chiffre aléatoire.

Pour l'utiliser dans ton code, cela devrait donner

Code:

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
function CreatNomFichier(DossDest)
dim T
Randomize
for T = 0 to 5
        CreatNomFichier = CreatNomFichier & cstr(Int((9 * Rnd) + 1))
next
CreatNomFichier = DossDest & CreatNomFichier & ".PNG"
if FichierExiste(CreatNomFichier) = True then CreatNomFichier(DossDest)'recommencer le tirage aléatoire
end function
 
function FichierExiste(ChemDoss) ' le fichier existe t'il
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
FichierExiste = oFSO.FileExists(CreatNomFichier)
Set oFSO = NotHing
end fucntion
 
 
Sub Commentez()
Dim NonAleaFichier
NonAleaFichier = CreatNomFichier("C:\Users\Thibault\Desktop\")
'ActivePresentation.Slides(1).Export _
'FileName:="C:\Users\Thibault\Desktop\1.png", FilterName:="PNG"
 
ActivePresentation.Slides(1).Export _
FileName:=NonAleaFichier, FilterName:="PNG"
 
end sub

Question importante, tu veux faire cela en VBSCript ou en VBA dans Powerpoint (2007)?

Pourquoi poster ailleurs ? et surtout ne pas y revenir !

Salut, pourquoi ne pas utiliser une fonction comme celle-ci, qui pour un fichier nommé par exemple "Fusion", s'il existe déjà, nommera le second "Fusion(001)" le 3eme "Fusion(002)" etc

Code:

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
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object
 
 
   Set FSO = CreateObject("Scripting.FileSystemObject" )
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)
 
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000" ) & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
 
   RenommerFichier = sDossier & "\" & sNomfichier
End Function

Un exemple, qui n'a rien à voir avec ton fichier, mais permet de voir l'usage de cette fonction.

11/08/2017, 10h10
l_autodidacte

Bonjour kiki29

La question étant posée dans le forum VBScript, je ne sais pas si le demandeur sait que les variables ne doivent pas être typée ou non.

La fonction Format n'existe pas en VbScript mais il y a FormatNumer qui ne sera pas utile dans ce contexte puisque les "00" précèdent la valeur de i.

Une astuce pour contourner le problème : sNouveauNom = sPre & Chr(40) & Right("000" & Cstr(i), 3) & Chr(41) & Chr(46) & sExt