Copier coller racourci fichier excel vba

[Résolu/Fermé]
Signaler
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
-
 gnioler -
Bonjour,

bonjour
je cherche a savoir si quelqu'un peut m'aider en vba pour
copier une fichier nomée A dans le rep S:/a classer
et coller le racourci nomée pareil dans le rep S:/trié

merci


25 réponses

Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Salut Lermitte222, gnioler

Excusez l'incruste...

Si j'ai bien compris la problématique du jour (et je dit bien SI...), j'ai eu à utiliser cette fonction glanée sur le net (je sais plus ou...) qui créé un raccourci avec 3 paramètres :
- le chemin d'accès complet au répertoire ou sera stocké le lien,
- le nom de ce lien,
- le chemin d'accès complet au fichier.

Cette fonction utilise la bibliothèque "Windows Script Host Object Model".
Pour l'activer :
- Sous VBE Outils/références (ALT+F11 depuis la feuille)
- chercher puis cocher "Windows Script Host Object Model"

En voici le code :
Sub LancerFonction()
Dim RepDestination As String, NomLien As String, CheminFichierInitial As String
'pour toi : RepDestination = "S:\a trier\" toujours SI j'ai bien compris... 
     'Ne pas oublier le \ en fin de répertoire....
RepDestination = "C:\Documents and Settings\Travail\Bureau\"
NomLien = "Nom de mon lien"
'ici j'ai pris un fichier pdf au hasard
CheminFichierInitial = "E:\Utilisateurs\Mes documents\TRAVAIL\2012\Commandes.pdf""
Création_Raccourci RepDestination, NomLien, CheminFichierInitial
End Sub

'Activer la bibliothèque "Windows Script Host Object Model" :
    'Sous VBE Outils/références (ALT+F11 depuis la feuille)
    'chercher puis cocher "Windows Script Host Object Model"
Public Function Création_Raccourci(Repertoire As String, NomLien As String, AccesFichier As String)
Dim Lien As String
Dim Raccourci As WshShortcut
Dim wShom As WshShell

Lien = Repertoire & NomLien & ".lnk"
Set wShom = New WshShell
Set Raccourci = wShom.CreateShortcut(Lien)
With Raccourci
    .Description = NomLien
    .TargetPath = AccesFichier
    .WindowStyle = 3
    .Save
End With
Set Raccourci = Nothing
Set wShom = Nothing
End Function
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Bonjour,
    FileCopy "a", "S:\a"

Pour l'autre question j'ai pas compris.
A+
bonjour

et merci pour votre reponse je me suis mal exprimé

je voudrait copier un fichier nomé "devis" qui se trouve dans le repertoire
"S:/a classer"

et coller le racourcie dans le dossier
"S:/trié"
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
et coller le racourcie dans le dossie
Je ne comprend pas ce que tu veux dire
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
quand tu copie un fichier avec le clic droit de la sourie et que tu fait un clic droit dans un autre dossier pour le coller tu as le choix entre coller le fchier ou coller le racourcie du fichier
et moi je veut juste coller un racourcie de ce fichier car la racine elle doit rester a sa place

pour résumer j'ai 2 dossier
1 qui s'apelle "a classer" ou il y a tous les devis
et 1 qui s'apelle "a trier" ou je voudrait un racourcie des fichier excel qui se trouvent dans "a classer"
car par la suite je vais ranger dans les dossier client uniquement les racourcie des devis la racine de tous les devis reste dans le pot commun " a classer"
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Autrement dis, en clair !!
Tu a un répertoire S:\a classer dans lequel se trouve tout les classeurs concernant tes devis.
Tu a un autre répertoire S\a trier et là tu voudrais un classeur avec tout les noms des classeurs qui se trouvent dans S\a classer.
C'est la bonne cette fois-ci ?
Si oui...Un classeur exemple
Il faut que le répertoire S:\a classer existe réellement, sinon il faut le changer dans la macros.
Quand fini tu sauve le classeur ou tu veux.
Tu dis.
A+

Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
non ce n'est pas exactement ce que je cherche
désolé mais je suis débutant et j'ai du mal a me faire comprendre
par contre
je te remercie car ce que tu m'a donné correspond exactement pour une autre application

pour celle ci je vais essayer de reprendre tes termes

"Tu a un répertoire S:\a classer dans lequel se trouve tout les classeurs concernant tes devis" pour ca c'est ok

par contre
" Tu a un autre répertoire S\a trier et là tu voudrais un classeur avec tout les noms des classeurs qui se trouvent dans S\a classer" non j'ai effectivement un autre repertoire S:\a trier dans lequel je voudrais la copie de tout les classeurs qui se trouvent dans S\a classer

par contre je cherche a mettre un racourcie du classeur et non le classeur en lui meme
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
beh y a pas moyen de mettre un raccourci dans un répertoire.
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Bonjour Pijaku,
+1 pour ta suggestion, bien que je n'ai pas eu facile de la mettre en oeuvre, les explications sont un peu ambiguës.
N'empêche, elle peut être utile même si ce n'est pas ce que gnioler veux ?
J'ai tout adapter pour que ce soit automatique avec sélection des répertoires par l'utilisateur, comme ça plus d'erreur dans les répertoires, (c'est déjà ça en moins :-D)

La version deux du classeur
A+
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Salut,

Parfait.
C'est vrai que j'ai manqué de précisions dans les explications et que les termes employés étaient tendancieux.

Ton classeur est tout bon, du moins je pense, pour l'utilisation du demandeur.

Bonne fin de journée.
A+
bonjour et merci beaucoup a tous les 2
la macro pour le raccourcie est exactement ce que je cherchais

par contre pour la 2eme merci aussi car ca m'est tres utile pour une autre appli
par contre est il possible de faire la meme en listant les dossier en non les fichiers
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Tu veux faire des raccourcis sur des dossiers ?
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
non pas du tout le probleme des racourcie est réglé

je veut lister les dossier d'un dossier donné comme ton exemple de la liste des fichiers
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Re,
Vais laisser un peu de boulot à Pijaku :-DD
Tu t'en charge ?
(Avec un sourire en coin) :-D
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Salut Lermitte222,
Gnioler,
J'ai envie de dire :
- merci à lermitte222 pour la confiance accordée
- Gnioler : ce sera tout? comme le dit si bien ma bouchère...

Lermitte222, me suis permis de reprendre ton classeur exemple et y ajouter le code demandé aujourd'hui.

En voici donc la version 3.0

Et le code :
Option Explicit 

Dim CheminSource As String 

Private Sub CommandButton2_Click() 
'Nécessite (du moins je crois) l'activation de la référence "Microsoft Scripting Runtime" 
    'Sous VBE (ALT+F11 depuis la feuille) : Outils/références 
    'chercher puis cocher "Microsoft Scripting Runtime" 
Dim fso As FileSystemObject, Lig As Integer 
Dim Rep As Folder, SousRep As Folder 
     
    CheminSource = SelectionRep("Sélectionner le répertoire") & "\" 
    Set fso = New FileSystemObject 
    Set Rep = fso.GetFolder(CheminSource) 
     
    For Each SousRep In Rep.SubFolders 
        Lig = Lig + 1 
        Range("C" & Lig) = Split(SousRep, "\")(UBound(Split(SousRep, "\"))) 
        'En option (inutile) le chemin d'accès aux sous répertoires : 
        'Range("D" & Lig) = SousRep 
    Next 
    Columns("C:C").EntireColumn.AutoFit 
End Sub 

Function SelectionRep(Titre As String) As String 
Const ssfTous = &H1 
Dim objShell As Object, objFolder As Object, oFolderItem As Object 
    Set objShell = CreateObject("Shell.Application") 
    Set objFolder = objShell.BrowseForFolder(&H0&, Titre, ssfTous) 
    If objFolder Is Nothing Then Exit Function 
    Set oFolderItem = objFolder.Items.Item 
    SelectionRep = oFolderItem.Path 
    Set objShell = Nothing 
    Set objFolder = Nothing 
    Set oFolderItem = Nothing 
End Function

What Else?
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Re,
Lermitte222, me suis permis de reprendre ton classeur exemple et y ajouter le code demandé aujourd'hui.

Mais c'est fait pour ça :-D
Par contre y a un petit bug dans le code, si ont sélectionne un DD par exemple C:\, retourne C:\\, pour y remédier
Function SelectionRep(Titre As String, Optional Slach As Boolean) As String     
Const ssfTous = &H1     
Dim objShell As Object, objFolder As Object, oFolderItem As Object     
    Set objShell = CreateObject("Shell.Application")     
    Set objFolder = objShell.BrowseForFolder(&H0&, Titre, ssfTous)     
    If objFolder Is Nothing Then Exit Function     
    Set oFolderItem = objFolder.Items.Item     

'MODIFIER ICI     
    SelectionRep = oFolderItem.Path & IIf(Slach And Right(oFolderItem.Path, 1) _     
    <> "\", "\", "")     

    Set objShell = Nothing     
    Set objFolder = Nothing     
    Set oFolderItem = Nothing     
End Function

et l'apel devient
    CheminSource = SelectionRep("Sélectionner le répertoire", True)

Comme quoi rien n'est jamais parfait.

Rem :
'Nécessite (du moins je crois) l'activation de la référence "Microsoft Scripting Runtime" 
tu peu enlever le (du moins je crois)
A+
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
NOTE : Je ne répond pas aux MP pour les questions techniques.
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Bonne remarque sur le \\, et très bonne solution.

Concernant le "du moins je crois", je m'explique.
J'ai testé ça sur un classeur exemple ou la référence n'était pas activée. La macro a fonctionné sans bug... Comme je savais pour l'avoir tester au préalable que cette référence était indispensable, je l'ai noté comme telle. En ajoutant ... du moins je crois...
Réellement ça m'a surpris.

A+
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Si c'était un classeur que tu testais il y avait peut-être l'ajout de sa référence dans le ThisWorkbook.
Ont devraient peut-être inclure ça dans nos démo ça éviterait aux helpeurs de se mélanger les pinceaux.
A+
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Si c'était un classeur que tu testais il y avait peut-être l'ajout de sa référence dans le ThisWorkbook.
Ouaip peut être... Je ne peux pas le vérifier car aussitôt transmis, aussitôt effacé... J'suis confus...

Quant à ton idée de l'inclure dans nos démos, je penses que ça serait source d'erreurs. Je crois qu'il vaut mieux prévenir que telle ou telle procédure ne fonctionne qu'en activant telle ou telle référence, passer du temps à leur montrer comment faire. Cela évite d'avoir des messages à l'avenir :

demandeur : "ma macro marche pas"
helper : "peux tu préciser?"
demandeur : "ben j'ai un message d'erreur quand j'lance ma macro"
helper : "peux tu préciser : quel message d'erreur? qu'elle ligne apparait surlignée lors du débogage?"
demandeur : "ben il dit type définit par l'utilisateur non définit. la ligne jaune c'est sub trucbidule "
helper : il s'agit de tout ou de n'importe quoi. Donne ton code...
demandeur : Ben mon code c'est :
Sub trucBidule()
Dim fso As FileSystemObject, Lig As Integer
Dim Rep As Folder, SousRep As Folder
     
    CheminSource = SelectionRep("Sélectionner le répertoire") & "\"
    Set fso = New FileSystemObject
    Set Rep = fso.GetFolder(CheminSource)
     
    For Each SousRep In Rep.SubFolders
        Lig = Lig + 1
        Range("C" & Lig) = Split(SousRep, "\")(UBound(Split(SousRep, "\")))
        'En option (inutile) le chemin d'accès aux sous répertoires :
        'Range("D" & Lig) = SousRep
    Next
    Columns("C:C").EntireColumn.AutoFit
End Sub

Helper : "OK. active la référence "Microsoft Scripting Runtime" :
- Sous VBE (ALT+F11 depuis la feuille) : Outils/références
- chercher puis cocher "Microsoft Scripting Runtime"

Enfin j'te fais pas un dessin, tu les connais ces posts à rallonge...
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
bonjour a tous les 2 et merci beaucoup pour votre aide precieuse je suis débutant donc il me faut un peu de temps pour tout analyser mais j'ai fait l'essaie et c'est super car c'est ce que je souhaite a la perfection


par contre si je veut lister toujours le meme dossier sans avoir a le selctionner a debut, que faut t il suprimer et modifier
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Salut,
Si c'est toujours le même répertoire, voici un exemple. Il y a certainement plus simple, mais pour ça attendons l'expertise de Lermitte222.

Sub ListerRep()
Dim fso As FileSystemObject, Lig As Integer
Dim Rep As Folder, SousRep As Folder
 Dim CheminSource As String
    'met ton chemin d'accès au répertoire désiré ici
    CheminSource = "C:\Documents and Settings\Bureau\"    
    'ou dans la cellule A1 de ta feuille :
    ' CheminSource = Range("A1").Value 'avec saisi dans A1 : "C:\Documents and Settings\Bureau\"
Set fso = New FileSystemObject
    Set Rep = fso.GetFolder(CheminSource)
     
    For Each SousRep In Rep.SubFolders
        Lig = Lig + 1
        Range("C" & Lig) = Split(SousRep, "\")(UBound(Split(SousRep, "\")))
        'En option (inutile) le chemin d'accès aux sous répertoires :
        'Range("D" & Lig) = SousRep
    Next
    Columns("C:C").EntireColumn.AutoFit
End Sub
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 181
Bonjour à vous deux,
Rien à dire sur ton exemple.
Pijaku, petit exercice de style ?
Qui je pense serait le top pour gnioler
Compacter les deux procédures pour faire une arborescence sur plusieurs colonnes, genre TreeView, en adaptant ce code :-D
Je sais que tu aime les défis.
A+
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 654
Salut,

Oula! jolie procédure... Je regarde ça dès que j'ai 5 minutes (ou plutôt 5 heures...)

Mais effectivement le rendu peut êter superbe pour gnioler.
Au fait, est il encore là le demandeur???
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
bonjour
oui oui je suis toujours la et j'ecoute avec attention

et encore merci c'est super je m'y atelle tout de suite
Messages postés
88
Date d'inscription
mercredi 5 octobre 2011
Statut
Membre
Dernière intervention
7 janvier 2015
3
au fait si je veux lister tous les dossier de 3 dossier different
est ce que je mets 3 fois ce codes la