pb avec Workbook_Open avec Macro pourtant simple

Lazuli

XLDnaute Nouveau
Bonjour,

J'ai peu utilisé à ce jour les procédure Workbook_open et là je sèche..
J'ai une macro simple, qui fonctionne très bien dans un module, mais qui bloque procédure quand je la met dans une procédure Workbook_open.
En résumé :
j'ai besoin que chaque fin de mois, que je sois au bureau ou pas, un seul onglet d'un fichier en comptant plusieurs soit copié dans un autre fichier pour qu'un autre utilisateur vienne récupérer les informations de cet onglet.
J'ai donc prévu grâce au planificateur de tache de Windows qu'une feuille d'Excel s'ouvre dans lequel il y aurait une procédure Workbook_Open.
Cela marche au début, c'est à dire que le planificateur se lance, que la macro ouvre automatiquement le bon fichier, mais après cela bloque dès la 3ieme ligne et j'ai comme message : Erreur d'exécution '9' : L'indice n'appartient pas à la sélection.

Pourtant l'onglet que je lui demande de sectionner existe bien. D'ailleurs la macro fonctionne si je la met hors de Workbook_open.
Petite particularité cependant, le fichier BDD est un fichier partagé.

voici la macro :

Private Sub Workbook_Open()

ChDir "H:\Nvlle base"
Workbooks.Open Filename:="H:\Nvlle base\BDD.xlsm"
Sheets("Base").Select
Columns("B:EE").Select
Selection.Copy
Windows("test sauvegarde.xlsm").Activate
Sheets("Base Scoring").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("BDD.xlsm").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
ActiveWorkbook.Save
End Sub


Merci de l'aide que vous pourrez m'apporter.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : pb avec Workbook_Open avec Macro pourtant simple

Bonjour.
Essayez comme ça:
VB:
Private Sub Workbook_Open()
Workbooks.Open Filename:="H:\Nvlle base\BDD.xlsm"
ThisWorkbook.Worksheets("Base Scoring").[B:EE].Value = ActiveWorkbook.Worksheets("Base").[B:EE].Value
ActiveWorkbook.Close Savechange:=False
Me.Save
End  Sub
ThisWorkbook.Worksheets("Base Scoring") peut être remplacé par le nom de code VBA de la feuille, spécifié devant son nom Excel rappelé entre parenthèses dans la rubrique "Microsoft Excel Objets".
Cordialement.
 

Lazuli

XLDnaute Nouveau
Re : pb avec Workbook_Open avec Macro pourtant simple

Merci Dranreb,
J'ai tenté, votre proposition, cela change le code erreur, mais cela bloque au même endroit.
Maintenant il m'indique Erreur d'exécution '7' : Mémoire insuffisante.
Du coup j'ai tenté de limité ma zone à B1:EE1000, mais je retrouve le code erreur précédent : Erreur d'exécution '9' : L'indice n'appartient pas à la sélection.

Par ailleurs, que signifie à la fin du code "Me.Save" ?
Merci
 

Lazuli

XLDnaute Nouveau
Re : pb avec Workbook_Open avec Macro pourtant simple

A la réflexion, ce serait encore mieux si mes données étaient copiées dan un autre classeur que celui où il y a la macro, afin de na pas l'alourdir, ni de donner d'indication sur le chemin d’accès (c'est un tiers à l'entreprise qui va avoir accès à ce fichier).
Merci de votre aide
 

Dranreb

XLDnaute Barbatruc
Re : pb avec Workbook_Open avec Macro pourtant simple

Essayez comme ça:
VB:
Private Sub Workbook_Open()
Dim ClasSrc As Workbook, ClasCbl As Workbook
Workbooks.Open Filename:="H:\Nvlle base\BDD.xlsm": Set ClasSrc = ActiveWorkbook
Workbooks.Open Filename:="H:\Nvlle base\???.xlsm": Set ClasCbl = ActiveWorkbook
ClasCbl.Worksheets("Base Scoring").[B1:EE10000].Value = ClasSrc.Worksheets("Base").[B1:EE10000].Value
ClasCbl.Close Savechange:=True
ClasSrc.Close Savechange:=False
Me.Close Savechange:=False
End Sub


Bon. Reprenons le taureau par les cornes en laissant l'endroit dans l'état où on le trouve :
VB:
Private Sub Workbook_Open()
Const ChmSrc = "H:\Nvlle base", NomClsSrc = "BDD.xlsm", NomFeuiSrc = "Base"
Const ChmCbl = "H:\Nvlle base", NomClsCbl = ?, NomFeuiCbl = "Base Scoring"
Dim ClsSrc As Workbook, FSrc As Worksheet, ClsSrcÀFermer As Boolean, _
    ClsCbl As Workbook, FCbl As Worksheet, ClsCblÀFermer As Boolean
On Error Resume Next
Set ClsSrc = Workbooks(NomClsSrc)
If Err Then
   Err.Clear: Workbooks.Open Filename:=ChmSrc & "\" & NomClsSrc
   If Err Then MsgBox "Il n'existe pas de classeur source """ & NomClsSrc & """" & _
      vbLf & "sur """ & ChmSrc & """.", vbCritical, Me.Name: Exit Sub
   Set ClsSrc = ActiveWorkbook: ClsSrcÀFermer = True: End If
Set ClsCbl = Workbooks(NomClsCbl)
If Err Then
   Err.Clear: Workbooks.Open Filename:=ChmCbl & "\" & NomClsCbl
   If Err Then MsgBox "Il n'existe pas de classeur cible """ & NomClsCbl & """" & _
      vbLf & "sur """ & ChmCbl & """.", vbCritical, Me.Name: Exit Sub
   Set ClsCbl = ActiveWorkbook: ClsCblÀFermer = True:: End If
Set FSrc = ClsSrc.Worksheets(NomFeuiSrc)
If Err Then MsgBox "Il n'existe pas de feuille source """ & NomFeuiSrc & """" & _
   vbLf & "dans le classeur  """ & ClsSrc.Name & """.", vbCritical, Me.Name: Exit Sub
Set FCbl = ClsCbl.Worksheets(NomFeuiCbl)
If Err Then MsgBox "Il n'existe pas de feuille cible """ & NomFeuiCbl & """" & _
   vbLf & "dans le classeur  """ & ClsCbl.Name & """.", vbCritical, Me.Name: Exit Sub
FCbl.[B1:EE10000].Value = FSrc.[B1:EE10000].Value
If Err Then MsgBox "Erreur en tentant de copier les valeurs :" & vbLf & Err.Description, vbCritical, Me.Name: Exit Sub
If ClsCblÀFermer Then ClsCbl.Close Savechange:=True
If ClsSrcÀFermer Then ClsSrc.Close Savechange:=False
Me.Close Savechange:=False
End Sub
 
Dernière édition:

Lazuli

XLDnaute Nouveau
Re : pb avec Workbook_Open avec Macro pourtant simple

Whaououou

C'est beau, mais là je suis une peu dépassée.
J'ai tenté de voir fonctionner la macro en pas à pas, mais j'ai un message d'erreur que je ne sais résoudre :
Une zone surlignée apparait sur "Savechange:=" dans quatrième ligne en partant du bas (If ClsCblÀFermer Then ClsCbl.Close Savechange:=True) et il m'est le message d'erreur m'indique : "Erreur de Compilation Argument nommé introuvable".
La même problématique se pose sur les deux "Savechange:=" suivant si je désactive les lignes 1 à 1.

Les cornes du taureau m'échappent donc toujours ;-)

Merci de votre aide
 

Discussions similaires

Statistiques des forums

Discussions
312 565
Messages
2 089 729
Membres
104 266
dernier inscrit
christian Auletta