Discussion :

[Riri33]

Bonjour, désolé de vous déranger.

Débutant,

j'ai fait une macro qui fonctionne dans le classeur mais quand je la déplace pour l’utiliser en Projet Personnel.XLSB
elle ne fonctionne pas (rien ne se passe).
Je voudrai pouvoir utiliser la macro en Projet Personnel.XLSB pour d'autre dossier
Pouvez m'aidez s’il vous plait plusieurs jours que j’essaie de trouver le solution mais je n'y parviens pas.
Merci

[Patrice740]

Bonjour,

Bonjour, désolé de vous déranger.
Débutant,
j'ai fait une macro qui fonctionne dans le classeur mais quand je la déplace pour l’utiliser en Projet Personnel.XLSB
elle ne fonctionne pas (rien ne se passe).

Ici tu ne déranges personne, le rôle de ce forum est d'aider à résoudre les problèmes.
Par contre il convient d'expliquer son problème, de publier le code, très peu de personnes ouvrent les fichiers joints, en particulier lorsqu'ils contiennent des macro (voir : http://www.developpez.net/forums/d84...s-discussions/)
Si ta macro ne fonctionne pas il est fort probable que tu aie fait abstraction des la désignation des objets parents. Commence par là.

[Riri33]

Merci,

Bonsoir,

Désolé première fois que j'utilise un forum ,

J'ai travaillé sur la macro dans le classeur Banane
la j'ai fait une erreur car je voulais l'utiliser pour d'autre dossier .

Quand j'utilise la macro quand elle est dans le classeur tout fonctionne correctement:

VBAProject (Banane mfr124.xls)
-feuil1(feuil1)
-Module21 "la ou se trouve la macro"
-ThisWorkbook


Quand je met la macro dans VBAProject(PERSONNAL.XLSB) pour qu'elle fasse la même chose car j'ai besoin de l'utiliser pour d'autre dossiers
-VBAProject(PERSONNAL.XLSB)
-Module2 "la ou se trouve la macro"
-ThisWorkbook

Je lance la macro il y aucun message d'erreur mais la macro a fait aucun changement dans le classeur Banane .
C'est la que j'ai mon problème

Je vais tenter d'expliquer ce que j'essaie de faire.

J'ai dans mon dossier 3 fichiers excel ils ont en commun "mfr124"

-Banane mfr124.xls
-Choux mfr124.xls
-mfr124.xls

Je ne peux pas utiliser de chemin prédéfini.
J'ouvre mon fichier excel Banane,
je lance la macro il ouvre le deuxième fichier excel "Choux " qui est dans le même dossier
je lui demande de pas tenir compte de "mfr124" qui est commun au 3 fichiers pour les différencier mais qui lui changera dans les autres dossiers.
Il ouvre le classeur excel Choux et va dans l'onglet legume et je fais une recherche dans la feuille du terme CQF qui sera un point commun
pour tout les autres dossier, la colonne C sera toujours la même mais sur une ligne différente
Après différent copier/coller pour compléter .

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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub essai()
Dim cheminFichier As String
Dim Fichier As String
cheminFichier = ThisWorkbook.Path & "\"
Fichier = Dir(cheminFichier & "\*.xls")
'recherche le mot Choux avec une variable dans le dossier (ex: Choux aze12.xls) il y a seulement un fichier Choux dans le dossier
Do While Fichier <> ""
    If InStr(1, Fichier, "Choux", vbTextCompare) <> 0 Then  
        Workbooks.Open (cheminFichier & Fichier)
        'selection de l'onglet "legume" dans le fichier Choux
        Sheets("legume").Select
        'selection de la colonne C
        Columns("C:C").Select
        'recherche CQF dans la feuille "legume" dans la colonne C
        Selection.Find(What:="CQF", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        'selection de la cellule
        ActiveCell.Offset(0, -2).Select
        'copie ce que contient la cellule
        Selection.Copy
        'Classeur Banane
        ThisWorkbook.Activate
        ' ici j'applique  la suite de la macro pour copier/coller a certain endroit d'un classeur a un autre classeur qui sont dans le même dossier
        Workbooks(Fichier).Activate
        ActiveWindow.Close
        Exit Sub
    End If
    Fichier = Dir
Loop
End Sub

Les termes :
-Bananes
-Choux

Seront toujours commun dans les autres dossiers mais avec un chemin d’accès différents

[Patrice740]

Bonjour,

Si j'ai bien compris, il n'y a qu'un fichier Choux dans le répertoire, pas besoin de boucle :

Code VBA :

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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit
Sub essai()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim cel As Range
Dim pth As String
Dim nom As String
 
  Set wb1 = ActiveWorkbook
  If Not wb1.Name Like "Banane*.xls" Then
    MsgBox "Cette macro ne s'applique qu'aux classeurs Banane.xxxx.xls !", vbCritical
    Exit Sub
  End If
  pth = wb1.Path & "\"
  nom = Dir(pth & "Choux*.xls")
  If nom <> "" Then
    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(pth & nom)
    Set cel = wb2.Worksheets("legume").Columns("C:C").Find(What:="CQF", LookIn:=xlFormulas, LookAt:=xlPart)
    With wb1.Worksheets(1)
      .Range("G31").Value = cel.Offset(0, -2).Value
      .Range("H31").Value = cel.Offset(1, -2).Value
      .Range("G33").Value = cel.Offset(0, 4).Value
      .Range("H33").Value = cel.Offset(1, 4).Value
      .Range("G34").Value = cel.Offset(-5, 7).Value
      .Range("H34").Value = wb2.Worksheets("legume").Range("J2").Value
      .Range("F36").Value = "Min= " & Format(cel.Offset(0, 7).Value, "0.000") & " kg"
      .Range("F37").Value = "Max= " & Format(cel.Offset(1, 7).Value, "0.000") & " kg"
    End With
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
  End If
End Sub

[Riri33]

Bonjour,

merci Patrice740 ,

Votre code Fonctionne parfaitement ,
j'ai fait des erreurs dans les fichiers joint que j'ai corrigé,
il en reste encore une

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
18
19
20
21
22
23
24
With wb1.Worksheets(1)
      .Range("G31").Value = cel.Offset(0, -2).Value
      .Range("H31").Value = cel.Offset(1, -2).Value
      .Range("G33").Value = cel.Offset(0, 4).Value
      .Range("H33").Value = cel.Offset(1, 4).Value
      .Range("G34").Value = cel.Offset(0, 7).Value
      .Range("H34").Value = cel.Offset(1, 7).Value
      .Range("F36").Value = "Min= " & Format(cel.Offset(-5, 7).Value, "0.000") & " kg"
      .Range("F37").Value = wb2.Worksheets("legume").Range("J2").Value '"Max= " & "Range("J2").Value " & "0.000" & " kg"
 
 
    End With
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
 
     Set wb1 = ActiveWorkbook
 
      Range("F36:F37:G31:H31:G33:H33:G34:H34").Interior.ColorIndex = 2
      Range("G31:H31:G33:H33:G34:H34").NumberFormat = "0.0"
      Range("D48:D51").ClearContents
      Range("D48").Value = "Merci pour votre patience et votre aide"
 
  End If
End Sub

Sur cette ligne je ne sais pas comment faire

Code :

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

Range("F37").Value = wb2.Worksheets("legume").Range("J2").Value '   "Max= " & "Range("J2").Value " & "0.000" & " kg"

Je voudrai mettre la valeur de la cellule qui est en J2 de l'onglet legume du classeur Choux dans le classeur Banane en J37 .
Exemple: Max= 12.1 Kg
mais je n'arrive pas a insérer la valeur entre "Max=" et"Kg"
J'ai essayé pas mal de possibilité mais aucune n'a fonctionné
mise a part écrire faire des copier coller et des select et supprime ensuite.
Pouvez vous m'aidez s'il vous plait pour cette ligne ?
J'ai rajoute quelque ligne a la fin est ce correct s’il vous plait?

Merci

[Patrice740]

Bonjour,

Pour qu'une macro fonctionne correctement il faut que le code soit précis, c'est-à-dire ne laisser aucune ambigüité, par exemple :

Code VBA :

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
18
19
20
21
22
23
24
25
26
Option Explicit
Sub essai()
Dim classeur As Workbook
Dim plage As Range
Dim celluleTrouvee As Range
Dim celluleDestination As Range
Dim cheminDossier As String
Dim nomFichier As String
 
  Set celluleDestination = ThisWorkbook.Worksheets(1).Range("A2")  ' à adapter
  cheminDossier = ThisWorkbook.Path & "\"
  nomFichier = Dir(cheminDossier & "\*.xls")
  Do While nomFichier <> ""
    If InStr(1, nomFichier, "Choux", vbTextCompare) <> 0 Then
      Set classeur = Workbooks.Open(cheminDossier & nomFichier)
      Set plage = classeur.Worksheets("legume").Columns("C:C")
      Set celluleTrouvee = plage.Find(What:="CQF", LookIn:=xlFormulas, LookAt:=xlPart)
      If Not celluleTrouvee Is Nothing Then
         celluleTrouvee.Offset(0, -2).Copy Destination:=celluleDestination
         Set celluleDestination = celluleDestination.Offset(1)  ' destination suivante
      End If
      classeur.Close SaveChanges:=False
    End If
    nomFichier = Dir
  Loop
End Sub

Eviter les Select, selection, ...

[Riri33]

Merci Patrice740 ,


de votre aide et des nombreuses améliorations apportées .
Beaucoup de changement, sa va me permettre de m’améliorer et de comprendre toute les modifications merci .
Pour le moment je bloque sur la première ligne que je devais adapter .

j'ai essayé d'adapter cette ligne mais

Code :

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

Set celluleDestination = ThisWorkbook.Worksheets(1).Range(A2)  ' à adapter

en modifiant ainsi

Code :

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

Set celluleDestination = ThisWorkbook.Worksheets(Banane).Range(A2)  ' à adapter

J'ai essayé plusieurs changement mais toujours une erreur sur cette ligne en particulier sur Range .

La je travaille sur la macro que dans VBAProject(PERSONNAL.XLSB) pour éviter la mauvaise surprise que j'ai eu.

Pouvez vous m'aider sur cette ligne s'il vous plait ?
Merci

[Patrice740]

Bonjour,

Si tu ne veux qu'un chiffre après la virgule :

Code :

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

1
2
      .Range("F36").Value = "Min= " & Format(cel.Offset(-5, 7).Value, "0.0") & " kg"
      .Range("F37").Value = "Max= " & Format(cel.Offset(0, 7).EntireColumn.Cells(2).Value, "0.0") & " kg"

[Riri33]

Merci,

Patrice740 et Philippe Tulliez
pour votre patience et votre aide tout est parfait merci encore.

[Patrice740]

Re,

Il manque les guillemets anglais :

Code :

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

Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range("A2")  ' à adapter

[Riri33]

Bonjour,

J'avais déjà essayer

1. Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range("A2") ' à adapter

mais j'avais toujours une erreur malgré tout .

[Patrice740]

Quelle erreur ?
(il ne faut pas mettre le numéro de ligne)

[Riri33]

Bonjour,

encore merci de l'aide apportée.

Code :

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

1
2
3
4
Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range("A2")
Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range("")
Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range()
Set celluleDestination = ThisWorkbook.Worksheets("Banane")

J'ai essayé toute ces possibilités mais me renvoie une erreur en soulignant la ligne complète en jaune.
Je me demande si c'est pas dû au nom du classeur qui est Banane mfr124.xls.
Cette partie du nom du classeur sera toujours différente "mfr124" dans les autres dossiers.
La seule partie commune pour tout les autres dossiers est :
Banane
Choux
je me demande si le problème vient pas de la.

[Patrice740]

Le nom du classeur n'a rien voir. la bonne syntaxe est :

Code :

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

Set celluleDestination = ThisWorkbook.Worksheets("Banane").Range("A2")

(sans numéro de ligne)

Je répète : quelle est l'erreur renvoyée ????

[Patrice740]

Quand Philippe écrit :

Workbooks("Banane" & "le suffixe du nom" & ".xls" ("Le suffixe du nom" pouvant être par exemple mfr124)

Il faut comprendre et écrire :

Workbooks("Banane" & " mfr124" & ".xls".

ou plus simplement :

Workbooks("Banane mfr124.xls".

[Riri33]

Bonsoir Patrice740,

Merci

Code :

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

1
2
3
Set celluleDestination = Workbooks("Banane" & " mfr124" & ".xls").Range("A2")  
    cheminDossier = ActiveWorkbook.Path & "\"
    nomFichier = Dir(cheminDossier & "\*.xls")

J'ai un code erreur d’exécution '438':
Propriété ou méthode non gérée par cet objet

sur la ligne:

Code :

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

Set celluleDestination = Workbooks("Banane" & " mfr124" & ".xls").Range("A2")

Mais le suffixe ici dans l'exemple qui est mfr124 si j'applique la macro dans un autre dossier avec un classeur qui a comme suffixe tfr15f la macro fonctionnera t'elle ?
ou je devrais modifier le code au niveau du suffixe pour que la macro fonctionne pour un autre classeur ?

Exemple:

Code :

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

Set celluleDestination = Workbooks("Banane" & " tfr15f" & ".xls").Range("A2")

[Philippe Tulliez]

Bonjour,

Mais le suffixe ici dans l'exemple qui est mfr124 si j'applique la macro dans un autre dossier avec un classeur qui a comme suffixe tfr15f la macro fonctionnera t'elle ?
ou je devrais modifier le code au niveau du suffixe pour que la macro fonctionne pour un autre classeur ?

Si le classeur "Banane" & etc. est le classeur actif, ActiveWorkbook suffit

[Patrice740]

Bonjour,

Si le classeur "Banane" & etc. est le classeur actif, ActiveWorkbook suffit

Je préfère éviter les si ...
En particulier pour des macros dans Personnal.xlsb, utiliser ActiveWorkbook sans s'assurer qu'il s'agit du bon classeur, c'est prendre le risque d'appliquer la macro à n'importe quel classeur.
De façon plus générale je conseille d'éviter l'emploi des références aux objets actifs (Activeworkbook, ActiveSheet, Actvecell, Selection, ...) et par conséquence les références implicites qui peuvent générer une ambigüité.

[Riri33]

Bonjour,

merci de votre aide,
mais je ne ne vois plus comment m' y prendre malgré des recherche sur internet .