Discussion :

[ericdev67]

Bonjour,

Je souhaite créer une macro pour ouvrir un lien hypertexte qui ouvre un classeur et qui doit ensuite l'enregistrer dans un dossier (je sais pas très clair, c'est pourquoi je joins la macro)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Range("A1").Select
 
    Selection.Hyperlinks(1).Follow NewWindow:=True, AddHistory:=True
    ChDir "C:\Nouveau dossier (3)"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Nouveau dossier (3)\rrrr.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close

Mon soucis c'est que je vais le faire pour chaque cellule A1, A2,A3,.... et donc ma macro actuelle enregistre à chaque fois sous rrrr.xls, alors que chaque classeur (ouvert avec le lien hypertexte) porte un nom différent...

Si en plus, vous pouviez me donner le code pour que la macro aille automatiquement de la cellule A1, A2, A3,.....: c'est à dire range("toutes les cellules A").select, ce serait le bonheur total !!!!!

Merci

[ouskel'n'or]

Déjà, si tu mets le nom des classeurs en dur ("C:\Nouveau dossier (3)\rrrr.xls"), tous les classeurs auront bien évidemment le même nom...
Si tu veux leur donner des noms différents, utilise une procédure paramétrée avec le nom de chaque classeur placé dans un tableau.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Proc1()
Dim Tablo as variant, Rep as string
Rep = "C:\Nouveau dossier (3)\"
Tablo = Array("NomFichier1.xls", "NomFichier2.xls", "NomFichier3.xls", "NomFichier4.xls") 'etc
For i = 0 to Ubound(Tablo)
     Proc2 Rep, Tablo(i)
Next
End sub
 
Sub Proc2(Rep, NomFich)
    ActiveWorkbook.SaveAs Filename:= Rep & NomFich
    ActiveWorkbook.close
End sub

Pour parcourir une plage de cellule, c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Cell as range
For each Cell in Worksheets("Feuil1")Range("A1:A" & DerLig)
    Msgbox Cell
Next

Où Derlig est la dernière ligne de la plage et Msgbox uniquement là pour indiquer que tu peux lire "cell" de cette manière

[ericdev67]

Merci ouskel'n'or,

merci pour ta réponse rapide, mais mon niveau en VBA n'est pas terrible....j'ai copié ta macro et ça bloque....au niveau de la proc2 : activeworbook.saveAs Filename.......

En fait, dans mon tableau, il y a 2 colonnes :

A1 B1
1 1

Le lien hypertexte est en B1
Donc, la macro doit ouvrir le lien B1 (donc le classeur excel "1" s'ouvre), enregistrer dans "dossier 3" le classeur sous le nom "1" (=nom du lien hypertexte), aller sur B2 (où le lien hypertexte porte un autre nom), faire la même chose, et ainsi de suite jusqu'à la dernière ligne de B...comme ça, dans le "dossier 3", j'ai tous les classeurs.

D'après ce que j'ai compris ta macro se rapproche de cette solution, mais je n'arrive pas à la mettre en forme...

Je fais une extraction sous Access de classeurs, le "dossier 3" comportera les classeurs à jour, ou que j'ai envie d'extraire.


Merci pour ton aide

[ouskel'n'or]

Désolé mais là, je n'ai pas le temps de développer. Regarde l'utilisation de Follow à Hyperlinks dans l'aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

worksheets("feuil1").range("B2").Hyperlinks(1).follow

Bonne soirée
A+

[ericdev67]

Merci Ouskel'n'or,
Tu m'as donné les bonnes pistes...la classe.....j'ai trouvé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ouvriretenregistrerdansnvdossier()
Dim Lien As Hyperlink
Dim I As Byte
Dim Chemin As String, fichier As String
Chemin = "c:\eri\"
 
Application.ScreenUpdating = False
For Each Lien In ActiveSheet.Hyperlinks
    If Right(Range(Lien.Range.Address).Hyperlinks(1).Address, 4) <> "" Then
        Range(Lien.Range.Address).Hyperlinks(1).Follow NewWindow:=False
                fichier = ActiveWorkbook.Name
                ActiveWorkbook.SaveCopyAs Chemin & fichier
        ActiveWorkbook.Close
    End If
Next
Application.ScreenUpdating = True
End Sub

Et ça marche !!!!
Encore merci,
A+