VBA pour MAC: un problème avec le syntax

re

Est-ce que des macros ne marchent jamais sur les feuilles protégées?

Je pense que sous les versions 2007 le fait de protéger une feuille permet de faire fonctionner le code.

Si tu veux protéger au maximum, on peut déprotéger le temps de faire l'opération puis reprotéger ensuite.

Il existe aussi une instruction qui permet au code de continuer mais si tu utilises ton fichier sous windows et MAC, je ne te le conseille pas (A tester)

Fais toujours le test avec le code proposé, on verra le reste par la suite.

Je ne maitrise pas bien le français et même si tu donnes des instructions claires, pas toujours je suis capable de les comprendre. Le français n'est pas une langue facile

PAs de souci. J'avais remarqué cela mais je trouve que tu te débrouilles pas mal du tout. Quelle est ta langue ??? carsi tu le veux je peux peut être traduire dans ta langue pour que tu comprennes.

A te relire

Salut,

Je pense que sous les versions 2007 le fait de protéger une feuille permet de faire fonctionner le code.

Si tu veux protéger au maximum, on peut déprotéger le temps de faire l'opération puis reprotéger ensuite.

Il existe aussi une instruction qui permet au code de continuer mais si tu utilises ton fichier sous windows et MAC, je ne te le conseille pas (A tester)

Je suis tout à fait d'accord avec ta proposition. On verra ça plus tard, car le principe "If something can go wrong, it will" est toujours actuel.

Fais toujours le test avec le code proposé, on verra le reste par la suite.

Je l'ai testé. Les résultats sont:

1. Les données de BDC ont bien été récopié sur le fichier "BD consolidéés".

2. Le fichier "BD d'équipe 1.xls" a été trouvé et ouvert.

3. Les données de BDC n'ont pas été récopié sur le "BD d'équipe 1.xls".

4. Le curseur se trouve dans la colonne C ( N°d'équipe) du fichier "BD d'équipe 1.xls"

5. Je reçoie Erreur d'exécution '1004' La méthode PasteSpecial de la classe Range a échoué

6. Des lignes

.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _

xlNone, SkipBlanks:=False, Transpose:=False

sont en jaune.

PAs de souci. J'avais remarqué cela mais je trouve que tu te débrouilles pas mal du tout. Quelle est ta langue ??? carsi tu le veux je peux peut être traduire dans ta langue pour que tu comprennes.

merci, l'anglais peut être suffisant

Baton

re,

Les données de BDC n'ont pas été récopié sur le "BD d'équipe 1.xls".

Je n'ai pas le fichier BD équipe1.xls (sorry I don't have this file)

Il y a une feuille "Data" dans le fichier BD d'équipe 1.xls ou pas ? (Is there a sheet named "Data" in the workbook BD Equipe ?)

Amicalement

Je n'ai pas le fichier BD équipe1.xls (sorry I don't have this file)

Il y a une feuille "Data" dans le fichier BD d'équipe 1.xls ou pas ? (Is there a sheet named "Data" in the workbook BD Equipe ?)

le fichier "BD d'équipe 1" consiste de deux feuilles "Data" et "PT". Autrement dit, l'idée est souvegarder le contenue de chaque commande deux fois:

dans la base des données de chaque équipe ("BD d'équipe 1.xls" , "BD d'équipe 2.xls" etc.)

dans la base des données consolidées

amicalement,

Baton

re

Autrement dit, l'idée est souvegarder le contenue de chaque commande deux fois:

Dans le code je ne vois pas de sauvegarde concernant un fichier BD EQUIPE....

De base tout se passe avec le fichier BD consolidées Model .xls

Merci de m'expliquer un peu

Autrement dit, l'idée est souvegarder le contenue de chaque commande deux fois:

Dans le code je ne vois pas de sauvegarde concernant un fichier BD EQUIPE....

De base tout se passe avec le fichier BD consolidées Model .xls

Merci de m'expliquer un peu

Hello Dan,

The situation is as per below:

There are about 20 scientific groups (les équipes) + administration (also considerated as a group). Each group has to order different staffs for their activity. Therefore, a representative of each group fills the “Bon de commande d’équipe X” and sends it to the account department. Each group has two different budget lines at least. There is a standard form for each budget line presenting annual budget, planned expenses by type + real expenses by type + the balance (budget – real expenses). There is one group with 17 budget lines. Each order (commande) can be debited / paid by one budget line only. However, there are 4 major types of expenses.

Upon receiving the order, the account department finalizes it (usually the price adjustment can be done), and then this order has to be stored in two different data bases

1. The database of each team. Due to the pivot table, the team leader will be able to know on the real time his expenses by type / by budget line / by year. As well, he will know the balance.

2. The consolidated database. Will allow to the administration follow the all accounts, negotiate prices and etc.

VBA-NEW proposed to fix firstly the second database and after it resolve the problem with first one.

Best wishes,

Baton

Bonjour à tous,

@Dan

Dan a écrit :

Dans le code je ne vois pas de sauvegarde concernant un fichier BD EQUIPE

Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & " Model.xls")

On pourra enlever " Model" après.

Je résume la situation :

1- Chaque équipe fait une commande via le Bon de commande (fichier Bon de Commande 7 7 2011xxx.xls)

Dans le même Bon de commande, on peut avoir plusieurs commandes de plusieurs équipes.

2- Toutes ces commandes sont consolidées, compilées, récapitulées, etc. dans une BD consolidée (fichier BD consolidées Model.xls)

2bis- Ces mêmes commandes sont également dispatchées dans différentes BD propres à chaque équipe : fichiers BD d'équipe 1 Model.xls, BD d'équipe 2 Model.xls, BD d'équipe 3 Model.xls...

Ce sont les fichiers "BD d'équipe 1.xls" , "BD d'équipe 2.xls" dont parle Baton.

Bonjour,

Le mot "Model" a été suprimé et j'ai corrigé le code.

Baton

re,

merci VBANEW. Pas facile de s'y retrouver ... j'avais bien vu cette instruction Set exist fichier ....Model et me doutais qu'il y avait un souci par rappport aux deux fichiers que tu m'as donnés.

Pour Baton

Le mot "Model" a été suprimé et j'ai corrigé le code.

Ok. As-tu testé le code à nouveau et dis moi ce qui ne fonctionne pas. (After changing "Model", did you check the program ? If yes, let me know what doesn't work)

Ce serait bien que tu me donnes le code où tu as changé (it would be nice you just send me the code after modifcation)

Amicalement

Ok. As-tu testé le code à nouveau et dis moi ce qui ne fonctionne pas. (After changing "Model", did you check the program ? If yes, let me know what doesn't work)

Ce serait bien que tu me donnes le code où tu as changé (it would be nice you just send me the code after modifcation)

Salut Dan,

c'est le code du deuxième macro

Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
.Range("C3:Z45").Sort Key1:=.Range("C3"), Order1:=xlAscending, Key2:=.Range("D3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
nbLign = Application.CountIf(.Range("C3:C45"), numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 24)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls")
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If

Sheets("Data").Select
plageEquip.Copy
derLign = IIf(Range("C" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("C" & Rows.Count).End(xlUp).Row + 1)
With Cells(derLign, 3)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
'suppression des doublons
Columns(3).Insert xlToRight
For Each cel In Range("D" & derLign).Resize(nbLign)
doublon = Evaluate("SumProduct((" & Range("D3:D" & derLign - 1).Address & "=" & cel.Value & ")*(" & Range("E3:E" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
If doublon > 0 Then Cells(cel.Row, 3).Value = "$$$"
Next cel
Set trouve = Range("C" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
If Not trouve Is Nothing Then
For i = nbLign + derLign - 1 To derLign Step -1
If Cells(i, 3) = "$$$" Then Rows(i).Delete
Next i
End If
Columns(3).Delete
derLignC = Range("C" & Rows.Count).End(xlUp).Row
derLignA = IIf(Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("A" & Rows.Count).End(xlUp).Row + 1)
If derLignC > derLignA Then
For i = derLignA To derLignC
Cells(i, 1) = Cells(i - 1, 1) + 1
Next i
End If
Application.DisplayAlerts = False
.Delete
End With
End Sub

la ligne qui j'ai corrigé est

Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls")

quand même, chaque fois pendant l'exécution du macro consolide ils s'ouvrent deux petites fenêtre (pas en même temps) avec

ce texte:

Le classeur que vous avez ouvert comporte des liaisons avec un autre classeur.

avec deux boutons NON et OUI

est-ce que possible automatiser la reponse NON?

Bon après-midi

Baton

re,

quand même, chaque fois pendant l'exécution du macro consolide ils s'ouvrent deux petites fenêtre (pas en même temps) avec

ce texte:

Le classeur que vous avez ouvert comporte des liaisons avec un autre classeur.

avec deux boutons NON et OUI

est-ce que possible automatiser la reponse NON?

Oui j'ai vu cela. Il y a des liaisons avec un classeur appelé AERES

Doit-on garder ces liaisons ??

Dan a écrit :

re,

quand même, chaque fois pendant l'exécution du macro consolide ils s'ouvrent deux petites fenêtre (pas en même temps) avec

ce texte:

Le classeur que vous avez ouvert comporte des liaisons avec un autre classeur.

avec deux boutons NON et OUI

est-ce que possible automatiser la reponse NON?

Oui j'ai vu cela. Il y a des liaisons avec un classeur appelé AERES

Doit-on garder ces liaisons ??

Salut Dan,

Si on re-copie as value, il n'y a pas des raisons garder les liaisons.

Baton

re,

Si les liaisons ne servent pas, supprime les du fichier.

Pour supprimer les liaisons, essaie comme ceci :

• ouvre le fichier AERES
• ouvrant le fichier contenant les liaisons
• va dans Edition / Liaisons et sélectionne sur le fichier source dans la fenêtre
• clique sur le bouton "rompre les liaisons"

Cela supprimera les liaisons définitivement du fichier et tu ne verras jamais plus le message à l'ouverture du fichier.

Salut Dan,

Le fichier AERES fournit certaines données pour le fichier « Bon de commande » et il faut garder les liaisons. Par contre, quand on recopie les données du fichier « Bon de commande » dans les bases de données, il faut les coller « as value ». Il ne faut pas garder les liaisons avec AERES dans les bases des données.

The file AERES provides the « Bon de commande » with some essential data. This chain must be kept for this stage only.

However, after it, when the data is transferring to the data base files, all these liaisons are no more needed.

Merci ,

Baton

Salut Baton,

Essaie en rajoutant cette instruction à l'ouverture du fichier ---> updatelinks:=False

La ligne à modifier deviendrait ceci :

Workbooks.Open repertoire & "BD consolidées Model .xls", updatelinks:=False

Translation : Use the instruction "Updatelinks:= False" when opening the file. So the line code should be modified as follow -->

Workbooks.Open repertoire & "BD consolidées Model .xls", updatelinks:=False

If OK, tel me what's going wrong now.

Thks

Salut Dan,

J'ai recopié le code proposé

Sub consolide()
    ........
    Workbooks.Open "gestion:Dépenses:BD consolidées.xls", updatelinks:=False
    Set WbkConso = ActiveWorkbook

et ça marche. Maintenant, la fenêtre "Le fichier..." s'ouvre une seule fois et pas deux. Je n'ai pas trouvé ou il faut coller

, updatelinks:=False

la deusième fois.

L'avertisement ajouté est toujours là.

Amicalement,

Baton

re,

Je n'ai pas trouvé ou il faut coller la deuxième fois

Ici non ?

Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls"), updatelinks:=False

Edit Dan :

Pour le bug, on copie "Plageequip" vers "BD Equipe 1" ou "BD consolidée model" ??

For the bug, we copy "Plageequip" in the file "BD Equipe 1" or in the file "BD consolidée model" ??

N'oublie pas que la plage "Plageequip" est définie dans le classeur "bon de commande"

Don't forget that the range "Plageequip" defined and come from the workbook "bon de commande"

Dan a écrit :

re,

Je n'ai pas trouvé ou il faut coller la deuxième fois

Ici non ?

Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls"), updatelinks:=False

peut-être non parce que je reçoie l'avertisement de faute de compilation

Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
.Range("C3:Z45").Sort Key1:=.Range("C3"), Order1:=xlAscending, Key2:=.Range("D3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
nbLign = Application.CountIf(.Range("C3:C45"), numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 24)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls"), updatelinks:=False
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If

la première ligne est colorée en jaune et la ligne

Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & ".xls"), updatelinks:=False

est en rouge

Edit Dan :

Pour le bug, on copie "Plageequip" vers "BD Equipe 1" ou "BD consolidée model" ??

For the bug, we copy "Plageequip" in the file "BD Equipe 1" or in the file "BD consolidée model" ??

Il faut recopier le contenue deux fois: vers "BD Equipe 1" ou ET "BD consolidée model"

N'oublie pas que la plage "Plageequip" est définie dans le classeur "bon de commande"

Don't forget that the range "Plageequip" defined and come from the workbook "bon de commande"

Peut-être, il faut recopier cette ligne encore une fois amis pour le deusième fichier?

Re,

Pour la ligne qui est en rouge, veille à bien l'instruction à gauche dans le fenêtre. Si tu vois une instruction en rouge cela vient souvent d'une erreur dans l'écriture ou simplement d'un copier coller venant du forum.

Pour la ligne en jaune c'est un erreur dans la lecture du code. Là Excel ne comprend pas.

Dan a écrit :

Pour la ligne qui est en rouge, veille à bien l'instruction à gauche dans le fenêtre. Si tu vois une instruction en rouge cela vient souvent d'une erreur dans l'écriture ou simplement d'un copier coller venant du forum.

Pour la ligne en jaune c'est un erreur dans la lecture du code. Là Excel ne comprend pas.

Salut Dan,

Je n'ai fait aucun changement sur le code. Par contre, j'ai installé Office 2011 pour MAC. Dans cette version l'Excel "parle" VB.

Les problèmes du code sont disparu seuls.

Maintenant, si j'exécute le macro, il ouvre correctement deux base des données et recopie les données.

Il rest 3 opérations que je souhaitais que ce macro fasse:

1. Reactualiser les donnes qui se trouvent dans le Tableau Dynamique Croisé ( Pivot table) - ce le deuxième onglet de chaque base dee données

2. Sauvegarder les changements - les données copiées et réactualisées.

3. Fermer les bases de données.

Pourras-tu m'aidr avec ça?

Merci,

Baton

Bonjour au formum,

C'est le code final pour MAC qui repond parfaitement à ma demande initial:

Sub consolide()
    Dim WbkMaitre As Workbook, WbkConso As Workbook
    Dim nbLign As Long, derLign&, doublon&, i&, derLignC&, derLignA&
    Dim TblCde
    Dim repertoire As String
    Dim cel As Range, trouve As Range

    Application.ScreenUpdating = False
    'classeur maître : Fichier contenant le bon de commande
    Set WbkMaitre = ThisWorkbook
    repertoire = "gestion:Dépenses:" 'mettre le chemin du répertoire contenant les BD ici, laisser le ":" à la fin
    'If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire
    'classeur cible 1 : Fichier de commandes consolidées
    'ChDir repertoire
    'Workbooks.Open repertoire & "BD consolidées.xls"
    Workbooks.Open "gestion:Dépenses:BD_consolidees.xls", Updatelinks:=False
    Set WbkConso = ActiveWorkbook

    With WbkMaitre.Sheets("Commande")
'compte le nombre de ligne de commande
nbLign = .Application.WorksheetFunction.Count(.Range("C:C"))

'si le nombre de ligne est nul on sort de la macro
If nbLign = 0 Then MsgBox "La commande ne comporte aucune ligne": Exit Sub
    Set TblCde = .[C3].Resize(nbLign, 24)
    End With
    With WbkConso
.Activate
With .Sheets("Data")
      derLign = .Range("C" & Rows.Count).End(xlUp).Row + 1
        .Range("C" & derLign).Resize(nbLign, 24).Value = TblCde.Value
        TblCde.Copy
        .Range("C" & derLign).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
 'suppression des doublons
        For Each cel In .Range("C" & derLign).Resize(nbLign)
        doublon = Evaluate("SumProduct((" & .Range("C3:C" & derLign - 1).Address & "=" & cel.Value & ")*(" & .Range("D3:D" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
        If doublon > 0 Then Cells(cel.Row, 1).Value = "$$$"
            Next cel
                Set trouve = .Range("A" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
                If Not trouve Is Nothing Then
                For i = nbLign + derLign - 1 To derLign Step -1
                If .Cells(i, 1) = "$$$" Then .Rows(i).Delete
                Next i
            End If
        derLignC = .Range("C" & Rows.Count).End(xlUp).Row
        derLignA = IIf(.Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        If derLignC > derLignA Then
        For i = derLignA To derLignC
 .Cells(i, 1) = .Cells(i - 1, 1) + 1
                 Next i
            End If
        End With
   '.Close
End With

        With WbkMaitre
            .Activate
            a = .Sheets("Commande").Range("c3").Resize(nbLign).Value
            lim = UBound(a)
        ReDim temp(1 To lim, 1 To 1)
            k = 1
            cpt = 0
                temp(1, 1) = a(1, 1)
        For i = 1 To lim
        For j = 1 To lim
    If a(i, 1) = temp(j, 1) Then Exit For
                cpt = cpt + 1
        Next j
    If cpt = lim Then k = k + 1: temp(k, 1) = a(i, 1)
     cpt = 0
        Next i
        For i = 1 To k
        Call Cde_Equip(WbkMaitre, .Sheets("Commande"), repertoire, temp(i, 1))
        Next i
    End With
    Call sauvegarde
    End Sub

Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
.Range("C3:Z45").Sort Key1:=.Range("C3"), Order1:=xlAscending, Key2:=.Range("D3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
nbLign = Application.CountIf(.Range("C3:C45"), numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 24)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(rep & "BD_equipe_1.xls", Updatelinks:=False)
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If

Sheets("Data").Select
plageEquip.Copy
derLign = IIf(Range("C" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("C" & Rows.Count).End(xlUp).Row + 1)
With Cells(derLign, 3)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
'suppression des doublons
Columns(3).Insert xlToRight
For Each cel In Range("D" & derLign).Resize(nbLign)
doublon = Evaluate("SumProduct((" & Range("D3:D" & derLign - 1).Address & "=" & cel.Value & ")*(" & Range("E3:E" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
If doublon > 0 Then Cells(cel.Row, 3).Value = "$$$"
Next cel
Set trouve = Range("C" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
If Not trouve Is Nothing Then
For i = nbLign + derLign - 1 To derLign Step -1
If Cells(i, 3) = "$$$" Then Rows(i).Delete
Next i
End If
Columns(3).Delete
derLignC = Range("C" & Rows.Count).End(xlUp).Row
derLignA = IIf(Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("A" & Rows.Count).End(xlUp).Row + 1)
If derLignC > derLignA Then
For i = derLignA To derLignC
Cells(i, 1) = Cells(i - 1, 1) + 1
Next i
End If
Application.DisplayAlerts = False
.Delete
End With
End Sub

Sub sauvegarde()
'Macro Dan
Dim i
Application.ScreenUpdating = False
For i = Workbooks.Count To 1 Step -1
If Left(Workbooks(i).Name, 3) = "BD_" Then
With Workbooks(i)
    .Activate
   .RefreshAll
   .Close Savechanges:=True
End With
End If
Next
End Sub

Je voudrais rémercier à vba-new et à Dan pour leur assistance!

Baton