Aide e macro classeur

Le 09/03/2017 à 09:14

Bonjour,

Je voudrais svp créer une macro pour un fichier. Le principe est que j'ai un fichier master qui contient plusieurs onglets et qui va chercher dans plusieurs liaisons. Je dois entrer le nom du pays dans une cellule B10 et ensuite enregistrer dans un dossier, rompre les liaisons, et enregistrer. Je dois faire la même chose pour 65 pays. Pourriez vous m'aider svp pour avoir une macro qui puisse une fois que j'aurais entrer le nom du pays, enregistrer le fichier complet (avec tous les onglets actualisés) sous le dossier que je veux avec le nom du pays et rompre les liaisons.

Voici ce que j'ai fait à présent. ça marche bien mais ça ne m'enregistre que l'onglet en cours, et ça ne rompt pas les liaisons. Merci beaucoup pour votre aide.

Sub Archiver()

Dim extension As String

Dim chemin As String, nomfichier As String

Dim style As Integer

Application.ScreenUpdating = False

ThisWorkbook.ActiveSheet.Copy

extension = ".xlsx"

chemin = "C:\Users\utilisateur\Desktop\HSS\"

MsgBox ThisWorkbook.Path

nomfichier = ActiveSheet.Range("B10") & "_HSS_" & extension

With ActiveWorkbook

.ActiveSheet.DrawingObjects(1).Delete

.SaveAs Filename:=chemin & nomfichier

.Close

End With

ThisWorkbook.ActiveSheet.Copy

Lks = ActiveWorkbook.LinkSources()

If Not IsEmpty(Lks) Then

For i = 1 To UBound(Lks)

ActiveWorkbook.BreakLink Name:=Lks(i), Type:=xlExcelLinks

Next i

End If

End Sub

Je vous en serais reconnaissante;

Cordialement,

Hajar

Le 09/03/2017 à 09:48

Bonjour Hajar, bonjour le forum,

Peut-être comme ça :

Sub Archiver()
Dim extension As String
Dim chemin As String, nomfichier As String
Dim lks As Variant

Application.ScreenUpdating = False

If ActiveSheet.Range("B10").Value = "" Then
    MsgBox "Vous devez renseigner le nom en B10 !"
    Range("B10").Select
    Exit Sub
End If

extension = ".xlsx"
chemin = "C:\Users\utilisateur\Desktop\HSS\"
MsgBox ThisWorkbook.Path 'pourquoi faire cette ligne ?
nomfichier = ActiveSheet.Range("B10") & "_HSS_" & extension
With ActiveWorkbook
    On Error Resume Next
    .ActiveSheet.DrawingObjects(1).Delete
    On Error GoTo 0
    .SaveAs Filename:=chemin & nomfichier
    lks = .LinkSources(1)
    If Not IsEmpty(lks) Then
        For i = 1 To UBound(lks)
            ActiveWorkbook.BreakLink Name:=lks(i), Type:=xlExcelLinks
        Next i
    End If
    .Close SaveChanges:=True
End With
Application.ScreenUpdating = True
End Sub
Le 09/03/2017 à 09:53

Merci beaucoup !!! ça marche super bien !!!

Cordialement,

Hajar

Désolée de vous déranger encore mais je ne sais pas pourquoi la macro disparait une fois que je la lance? C'est embêtant parce que je dois refaire le process pour les 65 fichiers..

Merci beaucoup pour votre aide.

Cordialement,

Hajar

Le 09/03/2017 à 10:41

Re,

Il te faut placer la macro dans le fichier original et l'enregistrer sous avec l'extension .xlsm pour conserver le code. Sinon, logiquement elle n'apparaît plus à l ouverture...

En revanhe, comme tu as forcé l'extension .xlsx pour les fichiers copiés, eux n'auront pas la macro, mais ça, ça me paraît correct...

Le 09/03/2017 à 11:09

Re-Bonjour,

Effectivement j'ai enregistré sous le format xltm. Par contre je dois fermer le fichier et ensuite l'ouvrir pour que la macro marche. Le dernier souci svp est que quand je lance la macro, et que je reviens au fichier master pour entrer un deuxième pays, je ne retrouve plus mon petit bouton clik auquel j'ai affecté la macro. Comment le garder figé svp ?

Merci beaucoup pour votre aide précieuse.

Cordialement,

Hajar

Le 09/03/2017 à 11:20

Re,

On efface le bouton avant d'enregistrer sous, c'est donc logique !... Le code modifié :

Sub Archiver()
Dim extension As String
Dim chemin As String, nomfichier As String
Dim lks As Variant

Application.ScreenUpdating = False

If ActiveSheet.Range("B10").Value = "" Then
    MsgBox "Vous devez renseigner le nom en B10 !"
    Range("B10").Select
    Exit Sub
End If

extension = ".xlsx"
chemin = "C:\Users\utilisateur\Desktop\HSS\"
MsgBox ThisWorkbook.Path 'pourquoi faire cette ligne ?
nomfichier = ActiveSheet.Range("B10") & "_HSS_" & extension
With ActiveWorkbook
    .SaveAs Filename:=chemin & nomfichier
    On Error Resume Next
    .ActiveSheet.DrawingObjects(1).Delete
    On Error GoTo 0
    lks = .LinkSources(1)
    If Not IsEmpty(lks) Then
        For i = 1 To UBound(lks)
            ActiveWorkbook.BreakLink Name:=lks(i), Type:=xlExcelLinks
        Next i
    End If
    .Close SaveChanges:=True
End With
Application.ScreenUpdating = True
End Sub
Le 09/03/2017 à 11:23

Re

Avant d'essayer cette macro, je veux effectivement supprimer le bouton dans les fichiers enregistrés je suis d'accord c'est logique !

Mais dans mon fichier master où j'ai la macro j'ai envie de garder le bouton pour que'il suffise juste de changer le pays en B10, actualiser les liens, et hop lancer le bouton pour enregistrer, et re-belote pour les 65 pays. Que faire svp ?

Merci d'avance.

Cordialement,

Hajar

Le 09/03/2017 à 11:26

Pour ce qui est de l'enregistrement en tant que modèle (xltm), je ne pense pas que ce soit le plus adapté vu que tu fais toujours une copie de l'original... Donc, celui-ci reste inchangé.

L'original doit juste être .xlsm avec le nouveau code de mon post précédent.

Bon, reprenons car nos posts se sont croisés,

Tu as un fichier master avec bouton, macros, liens etc.

Tu cliques et la macro crée une copie sans liens, bouton et macro. je pense que si tu respectes les conseils de mon post précédent tu auras tout comme tu le désires...

Le 09/03/2017 à 11:36

Je suis vraiment désole de vous embêter j'ai enregitré le fichier master sous l'extension .xlsm et j'ai remis la denrière macro que vous avez posté, et j'ai un message d'erreur '1004' impossible d'utilsier cette extension avec le type de ficheir sélcetionné :'( je suis désespérée. j'ai fermé et rouvert le fichier activer le contenu et les liaisons, lancé la macro mais hélàs ça ne marche pas. Que faire svp ?

Merci beaucoup d'avance.

Cordialement,

Hajar

Le 09/03/2017 à 11:43

Re,

Quelle est la ligne de code surlignée de jaune quand la macro plante et que le message apparaît ?

Le 09/03/2017 à 11:45

cette ligne :

.SaveAs Filename:=chemin & nomfichier

et avec le fichier master en xltm ça marche très bien, sauf pour le bouton de la macro qui disparait du fichier master quand la macro est lancée.

Une dernière demande svp: comment changer la macro pour qu'elle ne ferme pas le fichier master quand la macro est lancée ? ça m'évitera de le rouvrir à chaque fois pour entrer le nom du pays.

Merci d'avance.

Cdt,

Hajar

cette ligne :

.SaveAs Filename:=chemin & nomfichier

et avec le fichier master en xltm ça marche très bien, sauf pour le bouton de la macro qui disparait du fichier master quand la macro est lancée.

Une dernière demande svp: comment changer la macro pour qu'elle ne ferme pas le fichier master quand la macro est lancée ? ça m'évitera de le rouvrir à chaque fois pour entrer le nom du pays.

Du coup je pense laisser l'extension xltm par contre ça serait génial si vous pouviez m'aider pour le dernier souci pour ne pas fermer le fichier master si possible une fois la macro lancée.

Merci d'avance.

Cdt,

Hajar

Le 09/03/2017 à 11:59

Re,

En effet j'ai compris... Nouveau code :

Sub Archiver()
Dim extension As String
Dim chemin As String, nomfichier As String
Dim lks As Variant

Application.ScreenUpdating = False

If ActiveSheet.Range("B10").Value = "" Then
    MsgBox "Vous devez renseigner le nom en B10 !"
    Range("B10").Select
    Exit Sub
End If

extension = ".xlsx"
chemin = "C:\Users\utilisateur\Desktop\HSS\"
MsgBox ThisWorkbook.Path 'pourquoi faire cette ligne ?
nomfichier = ActiveSheet.Range("B10") & "_HSS_" & extension
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs Filename:=chemin & nomfichier, FileFormat:=51
Application.DisplayAlerts = True
On Error Resume Next
.ActiveSheet.DrawingObjects(1).Delete
On Error GoTo 0
lks = .LinkSources(1)
If Not IsEmpty(lks) Then
For i = 1 To UBound(lks)
ActiveWorkbook.BreakLink Name:=lks(i), Type:=xlExcelLinks
Next i
End If
.Close SaveChanges:=True
End With
Application.ScreenUpdating = True
End Sub

Ça devrait fonctionner...

Le 09/03/2017 à 12:06

MERCI BEAUCOUP.

Du coup j'ai gardé le format .xltm, le fichier garde bien le bouton, mais malheureuement se ferme après que la macro soit lancé, donc je suis obligée de rouvrir le fichier, activer le contenu, rensiegner cellule B10, lancer macro, etc.

Je suppose qu'il n'y a pas de solution pour ça ?

En tout cas pour l'instant je suis satisfaite. S'il y a un solution à mon souci je vous serais reconnissante s'il y a une quelconque formule.

Merci !

Cdt

Hajar

Le 09/03/2017 à 12:26

Re,

Le fait d'enregistrer sous ferme automatiquement le fichier original. Voici un nouveau code pour le rouvrir :

Sub Archiver()
Dim CM As Workbook
Dim OM As Worksheet
Dim CC As Workbook
Dim NC As String
Dim extension As String
Dim chemin As String, nomfichier As String
Dim lks As Variant

Set CM = ThisWorkbook
Set OM = ThisWorkbook.ActiveSheet
NC = ThisWorkbook.FullName
Application.ScreenUpdating = False
If OM.Range("B10").Value = "" Then
    MsgBox "Vous devez renseigner le nom en B10 !"
    Range("B10").Select
    Exit Sub
End If
extension = ".xlsx"
chemin = "C:\Users\utilisateur\Desktop\HSS\"
nomfichier = OM.Range("B10") & "_HSS_" & extension
Application.DisplayAlerts = False
CM.SaveAs Filename:=chemin & nomfichier, FileFormat:=51
Application.DisplayAlerts = True
Set CC = ActiveWorkbook
On Error Resume Next
CC.ActiveSheet.DrawingObjects(1).Delete
On Error GoTo 0
lks = CC.LinkSources(1)
If Not IsEmpty(lks) Then
    For i = 1 To UBound(lks)
        CC.BreakLink Name:=lks(i), Type:=xlExcelLinks
    Next i
End If
Workbooks.Open NC
CC.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Le 09/03/2017 à 12:35

merci beaucoup mais ça ne marche pas. En fait il reconnait le workbook en format xlsx et donc message d'erreur fichier.xlsx introuvable alors que mon fichier est en xlmt comment définir que c'est ça l'extension de mon fichier svp ? en fait il m'ouvre le nouveau fichier en format xlsx avec la macro les boutons, etc.. je pense je vais rester sur ma dernière version

Merci d'avance;

Cdt

Hajar

Le 09/03/2017 à 13:35

Re,

Je t'ai dit plus haut que l'utilisation d'un modèle (xltm) n'était pas nécessaire. Essaie avec un fichier master xlsm et le dernier code.

Le 09/03/2017 à 13:49

merci beaucoup pour votre aide mais ça n'avait pas marché avec le format xlsm.. je ferai un dernier essai.

Merci beaucoup pour votre aide précieuse !

Cordialement,

Hajar

Le 10/03/2017 à 14:46

Bonjour,

Vous êtes un génie ça a marché !!

Une dernière demande ou plutôt une deuxième demande de macro si possible svp !

En fait ce même fichier qui marche super bien grâce à vous! me permet de calculer des valeurs dans une cellule N7. Je veux développer une macro pour qu'il puisse copier coller automatiquement cette valeur dans un autre fichier excel. En fait j'ai un fichier excel ou j'ai une liste de pays dans la colonne A, et une liste de valeurs dans la colonne B. A ce stade, je lançais mon premier fichier, renseignais le pays, il me calcule le montant en cellule N7. Je copie colle à la main sur le deuxième fichie excel celulle B7, etc pour tous les pays. Je me demande s'il y a une macro, pour que quand je rensigne le pays dans le fichier master en cellule I1, il reconnait le pays dans la colonne A du deuxième fichier, et renseigne automatiquement la cellule B7 ainsi de suite pour les autres pays (B8; B9; etx).

Si vous pouvez m'aider ça serait le top du top !!

Merci d'avance.

Cordialement,

Hajar

Le 13/03/2017 à 11:44

Bonjour Hajar, bonjour le forum,

C'est confus... Dans les premiers posts tu disais renseigner le pays dans le fichier master dans la cellule B10 et maintenant tu parles de I1 ???

Ce que tu demandes ne me semble pas compliqué mais il faut être précis. J'utiliserai Destination pour désigner ce second fichier.

Il me faut :

• Chemin d'accès du fichier Destination

• Nom du fichier Destination

• nom de l'onglet du fichier Destination où seront copiées les valeurs de N7

• Il faut que les noms dans la liste des pays du fichier Destination soient exactement identiques au nom tapé en B10 (ou I1 ??)

La macro ira rechercher dans la colonne A du fichier Destination, la valeur identique à B10 (ou I1 ??) du fichier master et va copier, dans la cellule trouvée décalée d'une colonne à droite, la valeur de N7 du fichier master...

J'attends tes réponses pour te proposer le code...

Le 13/03/2017 à 13:58

Bonjour,

Oui effectivement la cellule a changé car j'ai changé le fichier.

Alors pour récapituler:

* on renseigne la cellule I1 dans le fichier "Calcul 2017"

* une formule se calcule en celulle "N7"

* Je veux que le montant se copie colle automatiquement dans un autre fichier "Analyse" en cellule E4, avec le pays qui est déjà renseigné en cellule D4, et ainsi de suite. Je vous joins la liste des pays; Il faut qu'il reconnaisse en quelque sorte le pays en colonne D pour copier coller.

* Les noms des pays seront évidemment les mêmes que ceux renseignés dans la cellule I1

les deux fichiers se trouvent dans ce lien

C:\Users\utilisateur\Desktop\HSS

Merci beaucoup votre aide!

Cordialement,

Hajar

3analyse.xlsx (10.72 Ko)
Rechercher des sujets similaires à "aide macro classeur"