Déplacement d'un fichier spécifique

Le 11/04/2016 à 16:19

Bonjour à tous,

Je vous explique mon problème. J'ai crée un formulaire permettant que lorsque l'on clique sur un bouton, de concaténer plusieurs colonne pour me créer un nouveau nom. Ce bouton me change aussi mon ancien nom de fichier JPG par mon nouveau nom que je viens de créer. Mon fichier JPG à donc un nouveau nom.

Je voudrais ajouter dans ce bouton un déplacement vers un dossier défini de ce fichier, or la seule chose à laquelle je suis parvenu pour l'instant, c'est de déplacer tous mes fichiers en .JPG. Je n'arrive pas à juste déplacer mon fichier dont je viens de modifier le nom.

A la fin de mon code j'ai laissé ma macro qui fonctionne pour déplacer tous les *.JPG*. (à partir de 'déplacer les le fichier dont je viens de changer le nom (NouveauNom) )

Est-il alors possible de juste déplacer ma variable "NouveauNom" que je viens de créer ?

Voilà j'espère que mes explications sont claires, j'avoue que j'ai commencé le VBA par moi même que depuis une dizaine de jours et c'est le premier problème que je n'arrive pas à résoudre par moi-même

Merci d'avance 

Private Sub Bouton_Valider_Click()

    Dim L As Integer

'on met dans chaque case une valeur afin de créer notre nouveau nom de photo

    If MsgBox("Confirmez-vous l'insertion de ce nouvel outil ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
        L = Sheets("Feuil1").Range("a65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement ? la premi?re ligne de tableau non vide
        Range("B" & L).Value = TextBox1 + "_"
        Range("C" & L).Value = TextBox2 + "_"
        Range("D" & L).Value = ComboBox1
        Range("E" & L).Value = TextBox3 + ".jpg"
        Range("H" & L).Value = TextBox4

        'macro pour concaténer le nom
        Dim cell As Range, i As Byte, derlig As Long
    derlig = Split(Worksheets("Feuil1").UsedRange.Address, "$")(4)
    For Each cell In Range("A1:A" & derlig)
        cell = ""
        For i = 1 To 6
            Cells(cell.Row, 7) = Cells(cell.Row, 7) & Cells(cell.Row, i) & " "
        Next
        Cells(cell.Row, 7) = RTrim(Cells(cell.Row, 7))
    Next

    End If
    Unload Me

'macro pour renommer les fichiers
    Dim chemin As String, Fichier As Variant, ligne As Integer
    Dim AncienNom As String, NouveauNom As String
    Dim Source As String, Destination As String
    Dim objFSO As Object

    Dim CheminCourt As String
    Dim MaPlage As Range, Cel As Range

    chemin = "T:\CCIET\ECHANGES CCI\Donnees programmeurs- prereglage\rognage auto\photo originale\"
    CheminCourt = "T:\CCIET\ECHANGES CCI\Donnees programmeurs- prereglage\rognage auto\photo originale\"
    ChDrive "C"
    ChDir CheminCourt

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    With Sheets("Feuil1")

        'For Ligne = 2 To 402
        For ligne = 2 To 2

            AncienNom = .Range("H" & ligne).Value
            NouveauNom = .Range("G" & ligne).Value

            Fichier = Dir(chemin & AncienNom, 6)

            If Fichier = Empty Then
                MsgBox "le fichier " & AncienNom & " n'a pas été trouvé"
            Else
                Source = chemin & Fichier: Destination = chemin & NouveauNom
                objFSO.CopyFile Source, Destination
                Kill (chemin & AncienNom)

            End If

       Next ligne
    End With
    Cells.Clear
    Set objFSO = Nothing

    'déplacer le fichier dont je viens de changer le nom (Nouveau Nom)

Dim Source As String
Dim Destination As String
Dim NouveauNom As String

Source = "D:\Users\UX585940\Documents\stage\2- Plans de réglages automatiques\test1212\*.jpg*" 'ça me bouge tous les jpeg, je n'arrive pas à faire juste déplacer ma variable "NouveauNom"
Destination = "D:\Users\UX585940\Documents\stage\2- Plans de réglages automatiques\essai macro\test1212²"
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Source, Destination, True
Set Fso = Nothing

    End Sub
Le 11/04/2016 à 16:46

Bonjour

j'ai un peu de mal a lire ton code... peut-etre un peu de fatigue.... mais pour deplacer un fichier moi j'utilise l'objet fso.movefile.....

plutot qu'un copier sous un nouveau nom pour ensuite supprimer l'ancien fichier

fred

Après reflexion, si ton nouvel enregistrement est stocké à la suite de ton tableau existant, donc la dernière ligne correspond au dernier enregistrement, pourquoi fait une boucle pour passé en revu toutes tes lignes de tableau ???

Le 12/04/2016 à 08:25

Bonjour, et tout d'abord merci de ta réponse.

J'ai aussi essayé le fso.movefile mais je me suis retrouvé avec le même problème. Je n'arrive pas à déplacer le fichier jpeg que je viens de renommer.

Je sais déplacer ou copier : tout un dossier avec des fichiers de la même extension ou bien un fichier spécifique si je change le nom dans mon code. Mais je n'arrive pas à ce que mon code prenne le fichier sur lequel je suis en train de travailler et le déplacer automatiquement dans un dossier voulu.

Pour ton deuxième message, je ne sais pas quoi te répondre, c'est un bout de code que j'ai pris sur un forum et qui fonctionne donc je l'ai gardé.

Le 12/04/2016 à 08:49

bonjour

Est-ce exact que le nom du fichier en cours de traitement est enregistré a la derniere de ta feuille ???

fred

Le 12/04/2016 à 08:59
AncienNom = .Range("H" & ligne).Value
            NouveauNom = .Range("G" & ligne).Value

Non mon nouveau nom se retrouve en cellule G2 (grâce à la boucle for ligne = 2 To 2 je suppose). Ma macro "renommer" permet de changer le nom de mon JPEG qui se retrouve en H2 par le nouveau nom en G2. J'avoue que ce n'est pas un code "propre" mais étant novice, je l'ai fais marcher comme j'ai pu. A la base c'était une macro qui permettait de changer plusieurs noms de fichiers d'un coup

Le 12/04/2016 à 09:54

fourni un fichier test...

fred

Le 12/04/2016 à 10:17

Pardon, j'ai cru que le code du bouton suffisait

edit 11h33 : j'ai remis le fichier en supprimant les modules inutiles

Le 12/04/2016 à 14:00

J'ai réussi à corriger mon code et il est maintenant fonctionnel. Je le met s'il peut intéresser quelqu'un.

Merci Fred pour ton temps et ton aide

Option Explicit
Dim Ws As Worksheet

Private Sub Label4_Click()

End Sub

'Pour le formulaire
Private Sub UserForm_Initialize()
    Dim J As Long
    Dim i As Integer

    ComboBox1.ColumnCount = 1 'Pour la liste d?roulante Civilit?
    ComboBox1.List() = Array("TA_", "TB_")
    Set Ws = Sheets("Feuil1") 'Correspond au nom de votre onglet dans le fichier Excel
    With Me.ComboBox1
        'For J = 2 To Ws.Range("C" & Rows.Count).End(xlUp).Row
         '   .AddItem Ws.Range("C" & J)
       ' Next J
    End With
    For i = 1 To 4
        Me.Controls("TextBox" & i).Visible = True
    Next i

End Sub

Private Sub CommandButton4_Click()
  Dim FichImg As Variant

    FichImg = Application.GetOpenFilename("Tous types de fichiers (*.*),*.*")
    'Si aucun fichier n'est sélectionné on passe au traitement d'erreur (PasDeFichier)
    If FichImg = False Then GoTo PasDeFichier
    'Si le fichier sélectionné n'est pas une image
    'le traitement d'erreur va traiter la ligne d'insertion
    'ne rien faire et passer au traitement de l'erreur (PasUneImage)
    On Error GoTo PasUneImage
    'Tentative d'insertion du fichier dans le contrôle Image1
    Me.Image1.Picture = LoadPicture(FichImg)
    Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
    Exit Sub
'traitements d'erreurs
PasDeFichier:
MsgBox "Vous devez sélectionner un fichier Image pour l'insérer.", vbCritical
Exit Sub
PasUneImage:
MsgBox "Le format de fichier choisi ne convient pas.", vbCritical
End Sub

Private Sub Bouton_Valider_Click()

    Dim L As Integer

'on met dans chaque case une valeur afin de créer notre nouveau nom de photo

    'Test sur le messagebox pour voir si on veut insérer un nouvel outil ...
    If MsgBox("Confirmez-vous l'insertion de ce nouvel outil ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
        'si oui ....
        L = Sheets("Feuil1").Range("a65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement ? la premi?re ligne de tableau non vide
        Range("B" & L).Value = TextBox1 + "_"
        Range("C" & L).Value = TextBox2 + "_"
        Range("D" & L).Value = ComboBox1
        Range("E" & L).Value = TextBox3 + ".jpg"
        Range("H" & L).Value = TextBox4

        'macro pour concaténer le nom
        Dim cell As Range, i As Byte, derlig As Long
    derlig = Split(Worksheets("Feuil1").UsedRange.Address, "$")(4)
    For Each cell In Range("A1:A" & derlig)
        cell = ""
        For i = 1 To 6
            Cells(cell.Row, 7) = Cells(cell.Row, 7) & Cells(cell.Row, i) & " "
        Next
        Cells(cell.Row, 7) = RTrim(Cells(cell.Row, 7))
    Next

    'sinon on continue
    End If
    Unload Me

'macro pour renommer les fichiers
    Dim chemin As String, Fichier As Variant, ligne As Integer
    Dim AncienNom As String, NouveauNom As String
    Dim Source As String, Destination As String
    Dim objFSO As Object
    Dim Destination2 As String

    Dim CheminCourt As String
    Dim MaPlage As Range, Cel As Range

    chemin = "T:\CCIET\ECHANGES CCI\Donnees programmeurs- prereglage\essai\rognage auto\photo originale\"
    Destination2 = "T:\CCIET\ECHANGES CCI\Donnees programmeurs- prereglage\essai\rognage auto\photo modifiée\"

    CheminCourt = "T:\CCIET\ECHANGES CCI\Donnees programmeurs- prereglage\essai\rognage auto\photo originale\"
    ChDrive "C"
    ChDir CheminCourt

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    With Sheets("Feuil1")

        'For Ligne = 2 To 402
        For ligne = 2 To 2

            AncienNom = .Range("H" & ligne).Value
            NouveauNom = .Range("G" & ligne).Value

            Fichier = Dir(chemin & AncienNom, 6)

            If Fichier = Empty Then
                MsgBox "le fichier " & AncienNom & " n'a pas été trouvé"
            Else
                Source = chemin & Fichier: Destination = Destination2 & NouveauNom
                objFSO.CopyFile Source, Destination
                Kill (chemin & AncienNom)

            End If

       Next ligne
    End With

    Set objFSO = Nothing

    Cells.Clear

    End Sub

'Pour le bouton Quitter
Private Sub CommandButton3_Click()
    Unload Me
End Sub
Le 12/04/2016 à 19:25

Re

Tant mieux pour toi si tu as réussit à résoudre ton problème tout seul, j'ai pas eut le temps aujourd'hui avec le boulot....

a+

fred

Rechercher des sujets similaires à "deplacement fichier specifique"