macro fichier pdfRésolu

Question

Bonjour,

Je me prend la tête sévère avec une macro que j'essai de mettre en place.

Le but de cette macro (je vais essayer d'être clair) est de :

Lors d'un double clique dans un cellule,
je vais chercher un fichier PDF
je le déplace dans un dossier différent,
je le renomme en fonction d'un cellule de ma feuille,
j'ajoute un liens hypertexte dans la cellule double cliqué.

ce que bien sur je n'arrive pas à faire.

exemple :

dans ma feuille 1 


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim KeyCells As Range
Dim Lg As Integer, Cl As Integer
Lg = ActiveCell.Row 'N° de ligne
Cl = ActiveCell.Column 'N° de colonne
If Target.Address = "$H$6" Then Exit Sub 'Elimine le traitement de la cellule K6
If Cl = 8 Then InsererPDF2

End Sub


la macro


Sub InsererPDF2()
Dim chemin As String, ancienNom As String, nouveauNom As String, i As Long
Dim fc As String
Dim cheminComplet As String
Dim fso As Object, origine As String
Dim destination As String, reponse As Integer
Dim sortie As Byte, message As String
Dim KeyCells As Range
Dim Lg As Integer, Cl As Integer
Lg = ActiveCell.Row 'N° de ligne
Cl = ActiveCell.Column 'N° de colonne
'Choix du fichier PDF
  cheminComplet = Application.GetOpenFilename("texte files (*.PDF), *.PDF")
  
    'Copie le fichier dans un autre dossier:
    FileCopy cheminComplet, Application.Dialogs(5).Show


  'MsgBox cheminComplet
 ' fc = Split(cheminComplet, "")
x = cheminComplet
A = Split(x, "")
n = Len(A(UBound(A)))
MsgBox Right(cheminComplet, n)
ScreenUpdating = False


'Modifie le nom du fichier
            ancienNom = A(4) '& "" & strFileName
            nouveauNom = (Cells(Lg, 3).Value) & ".pdf" '"" & Replace(strFileName, ")", "_")
            Name ancienNom As nouveauNom

    'Création du lien
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
      cheminComplet & "" & nouveauNom, TextToDisplay:="O"

    Application.ScreenUpdating = True
End Sub

En l'état, ça ne ressemble plus à rien :) j'ai fait tellement d'essai que je ne sais même plus ou j'en suis moi même.

Je m'en remet donc à vous afin d'être aiguillé sur la marche à suivre pour réaliser ce projet.

Par avance merci.

______________________________________________________
Nous gagnerions plus de nous laisser voir tels que nous sommes, que d'essayer de paraître ce que nous ne sommes pas.

cs_eleve · Accepted Answer

Ouf.

Bon voila c'est terminé. et pas de tout repos.

heureusement que vous étiez la pour m'épauler :)

Alors pour ceux que ça intéresse, je vous laisse le code finale.

Cela permet d'archiver des fichiers très simplement, Enfin à mon sens, et d'en garder la trace dans votre classeur excel.
Il y à surement plus simple, des solutions existe peut être mais je ne les ai pas trouver.

Voici le code : 

Sub InsererPDF2()
Dim cheminComplet As String
Dim ancienNom As String, nouveauNom As String, i As Long
Dim id As Integer
Dim gf As String
Dim n As String
Dim FSO As New FileSystemObject
Dim Destination As String
Dim KeyCells As Range
Dim Lg As Integer, Cl As Integer
Lg = ActiveCell.Row 'N° de ligne
Cl = ActiveCell.Column 'N° de colonne

    ScreenUpdating = False

'Choix du fichier PDF
    cheminComplet = Application.GetOpenFilename("texte files (*.PDF), *.PDF")
  
'récupère le nom du fichier

    n = cheminComplet
    id = InStrRev(n, "")
    gf = Mid(n, 1, id)

'Modifie le nom du fichier

    ancienNom = n
    nouveauNom = (Cells(Lg, 3).Value) & ".pdf"
    Name ancienNom As nouveauNom
    
    'Deplace le fichier

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Destination = "D:\mon dossier\de\destination"
    FSO.CopyFile nouveauNom, Destination, True
    FSO.DeleteFile nouveauNom

'Création du lien
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Destination & "" & nouveauNom, TextToDisplay:="O"

    Application.ScreenUpdating = True
    
End Sub

Quand je vois le peu de ligne que contient cette macro et le temps passé ça fait peur lol.

Merci a vous.

______________________________________________________
Nous gagnerions plus de nous laisser voir tels que nous sommes, que d'essayer de paraître ce que nous ne sommes pas.

cs_eleve · Answer

Bonjour.

J'ai modifier un tant soit peu le code,

j'ai un erreur pour modifier le nom (surement sur la récupération de celui-ci) et j'ai l'impression que la copie de fichier ne s'effectue pas (peu être du à l'erreur du nom (ancienNom)

Voici le code modifié. si une âme charitable pouvait y jeter un yeux ce serait génial.

Sub InsererPDF2()
Dim ancienNom As String, nouveauNom As String, i As Long
Dim cheminComplet As String
Dim copy As String
Dim newDir As String
Dim FSO As New FileSystemObject
Dim LeFichier, Destination As String
Dim KeyCells As Range
Dim Lg As Integer, Cl As Integer
Lg = ActiveCell.Row 'N° de ligne
Cl = ActiveCell.Column 'N° de colonne


'Choix du fichier PDF
  cheminComplet = Application.GetOpenFilename("texte files (*.PDF), *.PDF")
  
'récupère le nom du fichier
    Dim nomFichier As String
    nomFichier = cheminComplet
    Dim id As Integer
    id = InStrRev(nomFichier, "")

    Dim gf As String
    gf = Mid(nomFichier, 1, id)


ScreenUpdating = False
    
    
    'newDir = "D:\mon dossier\de\destination" & nomFichier


    ScreenUpdating = False
    
'Deplace le fichier


Set FSO = CreateObject("Scripting.FileSystemObject")
Destination = "D:\mon dossier\de\destination"
LeFichier = cheminComplet '& "" & "*.*"
FSO.CopyFile LeFichier, ":D:\mon dossier\de\destination", True
'FSO.DeleteFile cheminComplet

'Modifie le nom du fichier

            ancienNom = nomFichier
            nouveauNom = (Cells(Lg, 3).Value) & ".pdf"
            Name ancienNom As nouveauNom


    'Création du lien
     ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
      nouveauNom, TextToDisplay:="O"

    Application.ScreenUpdating = True
End Sub



merci d'avance.


______________________________________________________
Nous gagnerions plus de nous laisser voir tels que nous sommes, que d'essayer de paraître ce que nous ne sommes pas.

cs_eleve · Answer

Bon je continu mon monologue :p

J'ai encore fait deux ou trois modif. ça progresse, même si j'ai envie de tout laisser tomber et de me taper les manip à la main (je gagnerais du temps vu la complexité de la macro (pour mon niveau bien sur)

donc je résume :

1 je sélectionne bien mon fichier PDF - OK

2 je récupère le nom
     la j'aimerais récupérer le nom du fichier sans le chemin d'accès. j'ai réussi à le faire un temps la ça ne fonctionne plus.

3 je déplace le fichier - OK

4 Je modifie le nom
     Le nom ce modifie dans l'ancien dossier mais pas dans la nouvelle destination

5 je crée le lien hyperlinks
     sauf que le chemin du lien est celui de mon classeur excel. je n'arrive pas a trouver comment changer celui ci.

Voici le nouveau code qui na pas énormément changer

Sub InsererPDF2()
Dim cheminComplet As String
Dim ancienNom As String, nouveauNom As String, i As Long
Dim newDir As String
    Dim id As Integer
    Dim gf As String
    Dim nomFichier As String
Dim FSO As New FileSystemObject
Dim LeFichier, Destination As String
Dim KeyCells As Range
Dim Lg As Integer, Cl As Integer
Lg = ActiveCell.Row 'N° de ligne
Cl = ActiveCell.Column 'N° de colonne

    ScreenUpdating = False

'Choix du fichier PDF
    cheminComplet = Application.GetOpenFilename("texte files (*.PDF), *.PDF")
  
'récupère le nom du fichier

    nomFichier = cheminComplet
    id = InStrRev(nomFichier, "")
    gf = Mid(nomFichier, 1, id)
    
    MsgBox nomFichier
    
        'newDir = "D:\mon dossier\de\destination" & nomFichier
    
'Deplace le fichier

    Set FSO = CreateObject("Scripting.FileSystemObject")
    LeFichier = cheminComplet '& "" & "*.*"
    Destination = "D:\mon dossier\de\destination"
    FSO.CopyFile LeFichier, Destination, True
'FSO.DeleteFile cheminComplet

'Modifie le nom du fichier

    ancienNom = nomFichier
    nouveauNom = (Cells(Lg, 3).Value) & ".pdf"
    Name ancienNom As nouveauNom

'Création du lien
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    nouveauNom, TextToDisplay:="O"

    Application.ScreenUpdating = True
    
End Sub

...



______________________________________________________
Nous gagnerions plus de nous laisser voir tels que nous sommes, que d'essayer de paraître ce que nous ne sommes pas.

cs_eleve · Answer

Encore moi.

1 je sélectionne bien mon fichier PDF - OK 

2 je récupère le nom 

3 je déplace le fichier - OK 

4 Je modifie le nom - OK J'ai inversé l'ordre d&#8217;exécution 3 et 4 par 4 et 3
 
5 je crée le lien hyperlinks 
sauf que le chemin du lien est celui de mon classeur excel. je n'arrive pas a trouver comment changer celui ci. 

A suivre.
______________________________________________________
Nous gagnerions plus de nous laisser voir tels que nous sommes, que d'essayer de paraître ce que nous ne sommes pas.

Macro fichier pdf

4 réponses

Votre réponse

Discussions similaires