Macro compatible tout xls

Version imprimable

bonjour tout le monde

Je reviens avec une nouvelle formulation car il me semble que j'ai pas été clair lors de la premiére , je veux eviter de faire du copier coller des données avant de les traiter avec ma macro.

j'ai enregistré la macro sur le ruban mais elle ne fonctionne qu'avec le .xls sous lequel j'enregistre !!

est ce que je peux faire en sorte qu'elle fonctionne un n'importe qu'elle xls que j'ouvre ?
c'est surtout les lignes qui ne s'exécute pas!!!

Code:

1
2
Code = .Cells(Val.Row, 2).Value
     ThisWorkbook.Range("C" & ligne) = Code

merci

Code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub MEF()
    Dim CIBLE, Code As Variant
    Dim ligne As Integer
    Dim Val As Range
Worksheets(1).Columns("C:C").Insert Shift:=xlToRight
Worksheets(1).Columns("N:N").Insert Shift:=xlToRight
 
ThisWorkbook.Worksheets(1).Cells(1, 3) = "ARTICLE "
ThisWorkbook.Worksheets(1).Cells(1, 13) = "DATE"
 For ligne = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If (IsEmpty(Range("A" & ligne))) Then
    'MsgBox "Code Article Manquant à la ligne " & ligne
    Exit Sub
    Else
    CIBLE = Range("A" & ligne)
    Range("M" & ligne) = Left(Range("M" & ligne).Value, 9)
 
If Split(UCase(Range("O" & ligne).Value), "/")(1) = "M" Then
       Range("L" & ligne).Value = Range("L" & ligne).Value / 1000
End If
Range("N" & ligne).Value = Format(Range("M" & ligne).Value, "yyyymm")
   Feuil1.Range("K" & ligne).NumberFormat = "###0"
       'MsgBox "Code Article " & CIBLE & " recherche"
        Call Find(CIBLE, Code, ligne)
 End If
Next ligne
End Sub
Sub Find(CIBLE, Code, ligne)
Dim x As Variant
Dim Val As Range
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 Set wbk = Workbooks.Open("U:\redirection\reférence.xlsx")
 With wbk.Worksheets("Feuil1")
 Set Val = .Columns("A:A").Find(CIBLE, LookIn:=xlValues)
 If Not Val Is Nothing Then
   'MsgBox "Le Code Article" & CIBLE & "est dans la ligne: " & Val.Row
     Code = .Cells(Val.Row, 2).Value
     ThisWorkbook.Range("C" & ligne) = Code
        Else
    'MsgBox "Code Article " & CIBLE & " non trouvée dans la table de correspondance"
 End If
 End With
 wbk.Save
 wbk.Close
    Set wbk = Nothing
    Application.ScreenUpdating = True
 
End Sub

24/05/2012, 15h37
nchal
Bonjour,

Si j'ai bien tout compris. Tu souhaites faire qqchose, je ne sais pas trop quoi sur tous les Workbooks d'ouvert. Essaie cette petite boucle et si sa ne répond pas à ton problème, je te suggère de reformuler ton problème :
Code:

1 2 3 4 5 6 7 8 9 Sub boucleworkbook() Dim wb As Workbook For Each wb In Application.Workbooks 'met ton code ici Next End Sub
24/05/2012, 16h07
varik

je pense que vous m'avez devancer ,car j'étais entrain de reformuler mon probléme:

-j'ai plusieurs fichiers ; j'aimerais après l'ouverture d'un de ces fichiers pouvoir excécuter la fonction dont le code est posté dans mon premier message .

cette fonction ouvre un fichier pour chercher un code et l'insérer devant le champ correspondant.

merci
24/05/2012, 19h46
nchal

Bonjour

Je crois avoir cerné le problème. Je pense que tu dois utiliser un template Excel. Tu pourra exécuter ta macro sur n'importe quel classeur.

Après je ne suis pas sur d'avoir tout compris (et oui, je suis pas en forme aujourd'hui) de l'aide serai le bienvenue si j'ai répondu de travers :oops:
24/05/2012, 23h02
fring
Bonsoir,

Il ne s'agit pas vraiment d'un template mais d'une macro complémentaire.
1. insérer le code dans un classeur vierge
2. enregistrer ce classeur au format xla
3. activer la macro via le menu Outils --> Macro complémentaire
25/05/2012, 11h37
varik

merci beaucoup pour cette information .

je viens de faire ce qu'il faut mais vous pensez qu'il faut adpater le code aussi ?

pourquoi je vous demande ?

la macro se lance mais ne donne pas de résultat ou n'agit pas sur le classeur ouvert .

merci

oui il faut changer ThisWorkbook par ActiveWorkbook et lier les différents Range à la feuille du classeur actif

En clair, ça devrait donner ça :

Code:

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
Sub MEF()
    Dim CIBLE As Range, Code As Variant
    Dim ligne As Integer
    Dim Val As Range
 
With ActiveWorkbook.Sheets(1)
    .Columns("C:C").Insert Shift:=xlToRight
    .Columns("N:N").Insert Shift:=xlToRight
 
    .Cells(1, 3) = "ARTICLE "
    .Cells(1, 13) = "DATE"
 
    For ligne = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If (IsEmpty(.Range("A" & ligne))) Then
            'MsgBox "Code Article Manquant à la ligne " & ligne
            Exit Sub
        Else
            CIBLE = .Range("A" & ligne)
            .Range("M" & ligne) = Left(.Range("M" & ligne).Value, 9)
 
            If Split(UCase(.Range("O" & ligne).Value), "/")(1) = "M" Then
                .Range("L" & ligne).Value = .Range("L" & ligne).Value / 1000
            End If
            .Range("N" & ligne).Value = Format(.Range("M" & ligne).Value, "yyyymm")
            .Range("K" & ligne).NumberFormat = "###0"
            'MsgBox "Code Article " & CIBLE & " recherche"
            Call Find(CIBLE, Code, ligne)
        End If
    Next ligne
End With
 
End Sub

Faire la même modif dans l'autre Sub

j'arrive pas a décrire la syntaxe dans cette ligne pour écrire directement sur le Activeworkbook.

j'ai fait dérouler en pas a pas et la variable code comprend la valeur souhaite mais j'arrive pas à l'insérer dans

Code:

Range("C" & ligne

merci de votre collaboration
Code:

1 2 3 4 5 Set Val = wbk.Worksheets(1).Columns("A:A").Find(CIBLE, LookIn:=xlValues) If Not Val Is Nothing Then 'MsgBox "Le Code Article" & CIBLE & "est dans la ligne: " & Val.Row ActiveSheet.Cells(Val.Row, 2).Value = Code Code = ActiveWorkbook.Worksheets(1).Range("C" & ligne)

Si je comprend bien ce que tu cherches à faire, il n'est pas nécessaire de passer par la variable Code, essaie ceci :

Code:

1
2
3
4
5
Set Val = wbk.Worksheets(1).Columns("A:A").Find(CIBLE, LookIn:=xlValues)
If Not Val Is Nothing Then
    'MsgBox "Le Code Article" & CIBLE & "est dans la ligne: " & Val.Row
    ActiveWorkbook.Worksheets(1).Range("C" & ligne) = wbk.Worksheets(1).Cells(Val.Row, 2).Value
End Sub

28/05/2012, 13h32
varik

merci , je sais pas pour quoi dans mon cas cela ne fonctionne pas !!

il arrive pas a prendre la valeur de Cells(Val.Row, 2) pour la mettre dans Range("C" & ligne)

Code:

wbk.Worksheets("Feuil1").Cells(Val.Row, 2).Value = ActiveWorkbook.Worksheets("Feuil1").Range("C" & ligne)

je sais pas comment contourner cela .
28/05/2012, 18h11
fring
Probablement parce qu'il ne trouve pas la CIBLE

Tu as déclarer CIBLE As Range mais ne chercherais tu pas plutôt la valeur contenue dans la cellule CIBLE ?

Ce qui donnerait dans la déclaration de la variable
Code:

1 2 Dim CIBLE As Variant 'variant parce que je ne connais pas le type de valeur recherchée (texte, nombre, date, ...)

merci, je suis passé par comme vous aviez indiqué

Code:

1
2
3
Dim objWorkbookSource As Workbook, objWorkbookCible As Workbook
set objWorkbookSource = Application.Workbooks.Open(Application.GetOpenFilename)
set objWorkbookCible = Application.Workbooks.Add

bonne journée