Insertion fichier drag and drop

Bonjour à tous,

Je dispose d'un fichier au sein duquel je gère des achats.

Je souhaite (depuis un moment mais sans succès) ajouter une zone sur mes feuilles d'achats au sein de laquelle je pourrais glisser et déposer un fichier de mon choix (par exemple un devis pdf).

J'ai essayé de chercher pas mal sur internet ; j'ai abouti à des exemples avec OLE objects mais j'avoue être très limité dans la compréhension de ces objets et ne rien avoir trouvé de similaire à ce dont j'ai besoin.

Une fois le fichier déposé dans la zone prévue à cet effet, ce fichier serait copié vers un sous-dossier du dossier courant par exemple \Devis et un lien hypertexte vers cette copie du fichier apparaîtrait dans le range("A1") ou autre part.

Ainsi, je stockerai tous mes fichiers devis vers le répertoire \Devis et je disposerai d'un lien hypertexte vers le devis en question sur ma feuille d'achats.

Cette méthode me permettrait d'archiver les documents d'une manière simple et efficace (le drag and drop me semble efficace).

Sauriez-vous me guider pour mener à bien cette tache ?

Je vous remercie par avance du temps que vous serez en mesure de me consacrer,

Bien à vous,

Alexandre

Bonjour Alexandre, bonjour le forum,

Pas trop compris ton histoire de faire glisser dans un zone...

Je te propose une autre méthode dans le fichier en pièce jointe. Tu cliques sur le bouton Ajout de fichiers et la boîte de dialogue Parcourir s'ouvre. Elle va te permette de sélectionner un ou plusieurs fichiers d'un même dossier qui viendront se copier dans le sous-dossier Devis du dossier contenant le ficher de la macro et se lister dans la colonne A de l'onglet Fichiers. Un lien hypertexte permettra d'ouvrir le fichier listé d'un simple clic.

Il te faut donc enregistrer le fichier dans un dossier de ton choix et créer, dans ce même dossier, un sous-dossier nommé Devis.

Dis-moi si ça te convient :

Le code du bouton :

Private Sub CommandButton1_Click()
Dim SF As Object 'déclare la variable SF (Système de Fichier)
Dim DD As String 'déclare la variable DD (Dossier de Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim F As String 'déclare la variable F (Fichier)

ActiveCell.Select 'enlève le focus au bouton
DD = ThisWorkbook.Path & "\Devis\" 'définit le dossier de destination DD
With Application.FileDialog(msoFileDialogFilePicker) 'prend en compte la boîte de dialogue [Ouvrir]
    .AllowMultiSelect = True 'premet la sélection multiple
    If .Show = -1 Then 'condition 1 : si la boîte est affichée
        For I = 1 To .SelectedItems.Count 'boucle sur tous les fichiers sélectionnés
            Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
            On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
            SF.CopyFile .SelectedItems(I), DD, False 'copie le fichier sélectionné dans le dossier de destination DD (génère une erreur si le fichier existe déja)
            If Err <> 0 Then 'condition 2 : si une erreur a été générée
                Err.Clear 'supprime l'erreur
                'condition 3 : si "oui" au message
                If MsgBox("Ce fichier existe déjà dans le dossier " & Chr(34) & "Devis" & Chr(34) & ". Voulez-vous le remplacer ?", vbYesNo, "ATTENTION") = vbYes Then
                    SF.CopyFile .SelectedItems(I), DD 'écrase le fichier déjà existant
                    F = Dir(.SelectedItems(I)) 'définit le fichier F
                    Set DEST = Columns(1).Find(F, , xlValue, xlWhole) 'définit la cellue de destination DEST
                    GoTo suite 'va à l'étiquette "suite"
                Else 'sinon
                    GoTo fin 'va à l'étiquette "fin"
                End If 'fin de la condition 3
            End If 'fin de la condition 2
            On Error GoTo 0 'annule la gestion des erreurs
            'définit la cellule de destination DEST
            Set DEST = IIf(Range("A2").Value = "", Range("A2"), Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
            F = Dir(.SelectedItems(I)) 'définit le fichier F
suite: 'étiquette
            'crée un lien vers le fichier
            ActiveSheet.Hyperlinks.Add Anchor:=DEST, Address:=DD & F, TextToDisplay:=F
fin: 'étiquette
    Next I 'prochain fichier de la boucle
    End If 'fin de la condition 1
End With 'fin de la prise en compte de la boîte de dialogue [Ouvrir]
End Sub

Bonjour ThauThème,

Quelle réponse impressionnante ! Je t'en remercie sincèrement !

Est-il envisageable de renommer le fichier inclus au dossier devis du nom de l'onglet indenté de _1, _2, _3 dans le cas où plusieurs fichiers sont sélectionnés sans changer les extensions ?

de cette manière, si je sélectionne toto.docx et tata.pdf, ces deux fichiers seront renommés en Nom_onglet_1.docx et Nom_onglet_2.pdf

Ainsi chacun de mes onglet de fichier aura ses devis liés même si ils ont des extensions différentes.

Concernant le répertoire Devis, j'ai pu voir que si le dossier n'était pas créé, cela ne fonctionnait pas. Est-ce normal ? (la création du dossier n'était pas dans ma requête initiale mais ça me semble plus pratique)

Effectivement mon glisser déposer n'est peut-être pas dans la logique de VBA. Je pensais à quelque chose un poil plus user-friendly permettant de glisser déposer un fichier reçu par mail dans une zone de mon classeur Excel et que ça fasse le même boulot que d'aller le rechercher par le biais de l'explorateur Windows. Mais je pourrai très bien m'en passer.

Merci d'avance de ta future réponse !

Bonsoir Alex, bonsoir le forum,

La version 2 avec les modifications demandées plus du bonus... (Arf ! Voilà que je parle comme dans les pubs quelle m... !)

• Comme j'ai bien compris que tu allais rapatrier des fichiers dans des onglets différents, le code ne s'applique plus au bouton mais il est placé dans un module standard (Module1 dans l'exemple). Tu pourras donc le lancer à partir de n'importe quel onglet soit en y créant un CommandButton qui aura pour code :

Module1.AjoutFich 'lance la procédure [AjoutFich] du module [Module1]

penser à adapter le nom du module si différent !...

soit en lançant la macro via la boîte de dialogues Macro (raccourci clavier [Alt]+[F8]).

• Le sous-dossier Devis est créé automatiquement, si il n'existe pas, dans le même dossier que celui où se trouve le fichier Excel.

• Les noms des fichiers reprennent le schéma : nom de l'onglet actif / underscore / numérotation automatique / extension originale EX : Feuil1_1.docx.

Le nouveau code (à placer désormais dans un module standard) :

Public Sub AjoutFich()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DD As String 'déclare la variable DD (Dossier de Destination)
Dim I As Byte 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim F As String 'déclare la variable F (Fichier)
Dim NF As String 'décalre la variable NF (Nom du Fichier)
Dim SF As Object 'déclare la variable SF (Système de Fichier)

ActiveCell.Select 'enlève le focus au bouton
Set O = ActiveSheet 'définit l'onglet O
DD = ThisWorkbook.Path & "\Devis\" 'définit le dossier de destination DD
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir DD 'définit le dossier courant (génère une erreur si ce dossier n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été généré
    Err.Clear 'supprime l'erreur
    MkDir DD 'créé le sous-dossier "Devis"
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
With Application.FileDialog(msoFileDialogFilePicker) 'prend en compte la boîte de dialogue [Parcourir]
    .AllowMultiSelect = True 'premet la sélection multiple
    If .Show = -1 Then 'condition : si la boîte est affichée
        For I = 1 To .SelectedItems.Count 'boucle sur tous les fichiers sélectionnés
            'définit la cellule de destination DEST (A2 si A2 est vide, sinon la première ligne vide de la colonne1 (=A) de l'onglet O
            Set DEST = IIf(O.Range("A2").Value = "", O.Range("A2"), O.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
            F = Dir(.SelectedItems(I)) 'définit le fichier F
            NF = O.Name & "_" & DEST.Row - 1 & Mid(F, InStrRev(F, ".", -1, vbTextCompare)) 'definit le nom du fichier (copié) NF
            Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers SF
            SF.CopyFile .SelectedItems(I), DD & NF 'copie le fichier sélectionné dans le dossier de destination DD avec NF comme nom
            ActiveSheet.Hyperlinks.Add Anchor:=DEST, Address:=DD & NF, TextToDisplay:=NF 'crée le lien hypertexte
    Next I 'prochain fichier de la boucle
    End If 'fin de la condition
End With 'fin de la prise en compte de la boîte de dialogue [Ouvrir]
End Sub

[Édition]

J'avais oublier une chose importante !... Ton idée du cliquer/déplacer est très intéressante mais je n'ai pas le niveau VBA nécessaire pour le faire...

Bonsoir ThauThème,

Je te remercie pour cette V2 et je vais m'empresser de l'adapter à mon besoin.

J'ai pu réaliser des tests et effectivement c'est très efficace et modulable.

Une petite question à propos de la Form utilisée sur les onglets, j'ai plutôt l'habitude d'utiliser des boutons (contrôle de formulaires) au lieu d'utiliser des Boutons de commande (contrôle ActiveX).

Sais-tu m'expliquer l'avantage de l'un par rapport à l'autre ?

Dans le cas du bouton (contrôle de formulaire), pour lui affecter une macro il suffit de cliquer droit dessus et d'affecter une macro. Aucun code VBA n'est requis. Pour ton exemple, une procédure privée est nécessaire sur chaque feuille et je n'ai pas l'impression que cette procédure puisse être globalisée au classeur pour plusieurs instances du bouton car si on la met dans le module en public, les boutons ne fonctionnent plus.

Je pense que ma problématique réelle est résolue. J'ai cependant une petite curiosité concernant le glisser-déposer et je ne clôture pas le sujet dans l'immédiat.

Si jamais quelqu'un d'autre dispose d'une solution de glisser déposer, je suis également preneur.

Un grand merci pour ton efficacité, ta sympathie et cette pertinente réponse.

A bientôt sur le forum,

Alex

Re,

Contrôle de formulaire ou ActiveX ?

Question d'habitude... Je n'utilise pratiquement jamais les contrôles de formulaire car ils ne disposent pas des mêmes [Propriétés] dont disposent les contrôles ActiveX. Place, par exemple, un CommandButton ActiveX et double-clique dessus. Regarde la fenêtre des [Propriétés] dans VBE (en bas à gauche) et regarde toutes les procédures qu'il accepte (en haut à droite, deuxième champ, [Procédures]). Mais après, c'est comme les coups et les douleurs hein... Ça ne se discute pas !

Là ou tu as raison c'est qu'en écrivant dans un module standard une procédure d'ouverture de l'UserForm, tu pourras l'affecter à tous les boutons (contrôle de formulaire). Par exemple dans le Module1 la procédure :

Public Sub UserGO()
UserForm1.Show
End Sub

Et après, à chaque nouveau bouton (formulaire) tu lui affectes cette procédure...

Alors qu'un contrôle ActiveX a son code directement dans le composant onglet (Feuil1(Feuil1) par exemple) dans lequel il est placé. Et il faudra le répéter dans tous les composant onglets... Malgré cela je préfère l'ActiveX que je trouve plus souple à coder.

Bonjour,

Je suis intéressé par cette macro pour l'utiliser dans une autre cellule et dans un autre dossier, ça j'ai réussis à le faire.

En collant la macro sur une forme, j'envoie en e32 et dans un dossier Note de calculs.

Mais comment faire pour ne pas renommer le fichier et copier dans la cellule cible seulement une partie du nom du fichier.

Par exemple avec le fichier "01010101AA - tv hifi.pdf" je voudrais copier seulement "01010101AA" dans la cellule cible avec le lien bien sur mais sans le .pdf. La longueur du nom du fichier peut changer mais pas la référence qui a toujours 8 caractères.

Encore mieux une foi copier la référence dans la cellule avec le liens vers le nouveau dossier et avec seulement avec les 8 caractères, on viendrait copier d'une autre cellule un texte pour renommer le fichier copié dans le dossier.... 8)

Je demande peux être beaucoup là.

Bonne soirée à tous.