Fichier excel qui réagit différement selon les postes de travail

Question

Bonjour, J'ai créé un fichier Excel utilisé par différentes personnes dans mon entreprise. Le hic c'est que les postes sont configurés différemment, et sur la période de test, on me remonte des erreurs dont je n'arrive pas à trouver la cause. Deux erreurs m'ont été remontées : 1. Erreur de compilation, projet ou bibliothèque introuvable 2. Erreur de compilation, membre de méthode ou de données introuvable. Dans le code VBA est surligné ".DR" dans "Me.DR.List = d1.keys" Mon code est le suivant : Option Compare Text Dim TblSelectdr(), TblSelectfiliale(), TblChoix1(), TblChoix2(), TblChoix3(), choix1(), choix2(), choix3(), memo1 Private Sub DR_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.DR.List = TblSelectdr Me.DR.Activate Me.DR.DropDown End Sub Private Sub DR_Change() If Me.DR <> "" And IsError(Application.Match(Me.DR, Sheets("Paramétrages_Filiales").Range("DR").Value, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = UCase(Me.DR) & "*" For Each c In TblSelectdr If UCase(c) Like tmp Then d1(c) = "" Next c Me.DR.List = d1.keys Me.DR.DropDown End If [C6] = Me.DR ': ActiveCell.Offset(, 1) = "": ActiveCell.Offset(, 2) = "" End Sub Private Sub RAISONSOCIALE_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.RAISONSOCIALE.List = TblSelectfiliale Me.RAISONSOCIALE.Activate Me.RAISONSOCIALE.DropDown End Sub Private Sub RAISONSOCIALE_Change() If Me.RAISONSOCIALE <> "" And IsError(Application.Match(Me.RAISONSOCIALE, Sheets("Paramétrages_Filiales").Range("RAISONSOCIALE").Value, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = UCase(Me.RAISONSOCIALE) & "*" For Each c In TblSelectfiliale If UCase(c) Like tmp Then d1(c) = "" Next c Me.RAISONSOCIALE.List = d1.keys Me.RAISONSOCIALE.DropDown End If [C7] = Me.RAISONSOCIALE ': ActiveCell.Offset(, 1) = "": ActiveCell.Offset(, 2) = "" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'DR If Not Intersect([C6], Target) Is Nothing And Target.Count = 1 Then selectdr = Application.Transpose(Sheets("Paramétrages_Filiales").Range("DR").Value) Set d1 = CreateObject("Scripting.Dictionary") For Each c In selectdr If c <> "" Then d1(c) = "" Next c TblSelectdr = d1.keys Me.DR.List = d1.keys Me.DR.Height = Target.Height + 3 Me.DR.Width = Target.Width Me.DR.Top = Target.Top Me.DR.Left = Target.Left Me.DR = Target Me.DR.Visible = True Me.DR.Activate 'If Target <> "" Then SendKeys "{esc}" Else Me.DR.Visible = False End If [C6] = Me.DR 'RAISON SOCIALE ''''''' If Not Intersect([C7], Target) Is Nothing And Target.Count = 1 Then ''''''' ''''''' Selectfiliale = Application.Transpose(Sheets("Paramétrages_Filiales").Range("RAISONSOCIALE").Value) ''''''' Set d1 = CreateObject("Scripting.Dictionary") ''''''' ''''''' For Each c In Selectfiliale ''''''' If c <> "" Then d1(c) = "" ''''''' Next c ''''''' ''''''' TblSelectfiliale = d1.keys ''''''' Me.RAISONSOCIALE.List = d1.keys ''''''' Me.RAISONSOCIALE.Height = Target.Height + 3 ''''''' Me.RAISONSOCIALE.Width = Target.Width ''''''' Me.RAISONSOCIALE.Top = Target.Top ''''''' Me.RAISONSOCIALE.Left = Target.Left ''''''' Me.RAISONSOCIALE = Target ''''''' Me.RAISONSOCIALE.Visible = True ''''''' Me.RAISONSOCIALE.Activate ''''''' 'If Target <> "" Then SendKeys "{esc}" ''''''' Else ''''''' Me.RAISONSOCIALE.Visible = False ''''''' End If ''''''' '''''''[C7] = Me.RAISONSOCIALE If Not Intersect([C7], Target) Is Nothing And Target.Count = 1 Then Condition = UCase(Target.Offset(-1, 0)) If Condition = "" Then Exit Sub choixDR = Application.Transpose(Sheets("Paramétrages_Filiales").Range("DR").Value) choixFILIALE = Application.Transpose(Sheets("Paramétrages_Filiales").Range("RAISONSOCIALE").Value) ReDim TblSelectfiliale(1 To UBound(choixDR)) Set d1 = CreateObject("Scripting.Dictionary") For I = LBound(choixFILIALE) To UBound(choixFILIALE) If choixDR(I) = Condition Then d1(choixFILIALE(I)) = "" Next I TblSelectfiliale = d1.keys Me.RAISONSOCIALE.List = TblSelectfiliale Me.RAISONSOCIALE.Height = Target.Height + 3 Me.RAISONSOCIALE.Width = Target.Width Me.RAISONSOCIALE.Top = Target.Top Me.RAISONSOCIALE.Left = Target.Left Me.RAISONSOCIALE = Target Me.RAISONSOCIALE.Visible = True Me.RAISONSOCIALE.Activate 'If Target <> "" Then SendKeys "{esc}" Me.RAISONSOCIALE.DropDown ' ouverture automatique au clic dans la cellule (optionel) Else Me.RAISONSOCIALE.Visible = False End If [C7] = Me.RAISONSOCIALE '---- 'TYPE FOURNISSEUR If Not Intersect([C25], Target) Is Nothing And Target.Count = 1 Then choix1 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("TYPEFNR").Value) Set d1 = CreateObject("Scripting.Dictionary") For Each c In choix1 If c <> "" Then d1(c) = "" Next c TblChoix1 = d1.keys Me.TYPEFNR.List = d1.keys Me.TYPEFNR.Height = Target.Height + 3 Me.TYPEFNR.Width = Target.Width Me.TYPEFNR.Top = Target.Top Me.TYPEFNR.Left = Target.Left Me.TYPEFNR = Target Me.TYPEFNR.Visible = True Me.TYPEFNR.Activate 'If Target <> "" Then SendKeys "{esc}" Else Me.TYPEFNR.Visible = False End If [C25] = Me.TYPEFNR '---- 'TYPE DEPENSE If Not Intersect([C26], Target) Is Nothing And Target.Count = 1 Then Condition = UCase(Target.Offset(-1, 0)) If Condition = "" Then Exit Sub choix1 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("TYPEFNR").Value) choix2 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("TYPEDEP").Value) ReDim TblChoix2(1 To UBound(choix1)) Set d1 = CreateObject("Scripting.Dictionary") For I = LBound(choix2) To UBound(choix2) If choix1(I) = Condition Then d1(choix2(I)) = "" Next I TblChoix2 = d1.keys Me.TYPEDEP.List = TblChoix2 Me.TYPEDEP.Height = Target.Height + 3 Me.TYPEDEP.Width = Target.Width Me.TYPEDEP.Top = Target.Top Me.TYPEDEP.Left = Target.Left Me.TYPEDEP = Target Me.TYPEDEP.Visible = True Me.TYPEDEP.Activate 'If Target <> "" Then SendKeys "{esc}" Me.TYPEDEP.DropDown ' ouverture automatique au clic dans la cellule (optionel) Else Me.TYPEDEP.Visible = False End If [C26] = Me.TYPEDEP '--- ''''''''OBJET ''''''' ''''''' If Not Intersect([C27], Target) Is Nothing And Target.Count = 1 Then ''''''' Condition1 = UCase(Target.Offset(-2, 0)) ''''''' Condition2 = UCase(Target.Offset(-1, 0)) ''''''' If Condition1 = "" Or Condition2 = "" Then Exit Sub ''''''' ''''''' choix1 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("TYPEFNR").Value) ''''''' choix2 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("TYPEDEP").Value) ''''''' choix3 = Application.Transpose(Sheets("Paramétrages_Fiche").Range("OBJET").Value) ''''''' ligne = 0 ''''''' ReDim TblChoix3(1 To UBound(choix1)) ''''''' For I = LBound(choix2) To UBound(choix2) ''''''' If choix1(I) = Condition1 And choix2(I) = Condition2 Then ''''''' ligne = ligne + 1: TblChoix3(ligne) = choix3(I) ''''''' End If ''''''' Next I ''''''' ''''''' ReDim Preserve TblChoix3(1 To ligne) ''''''' Me.OBJET.List = TblChoix3 ''''''' Me.OBJET.Height = Target.Height + 3 ''''''' Me.OBJET.Width = Target.Width ''''''' Me.OBJET.Top = Target.Top ''''''' Me.OBJET.Left = Target.Left ''''''' Me.OBJET = Target ''''''' Me.OBJET.Visible = True ''''''' Me.OBJET.Activate ''''''' 'If Target <> "" Then SendKeys "{esc}" ''''''' 'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule (optionel) ''''''' Else ''''''' Me.OBJET.Visible = False ''''''' End If ''''''' '''''''[C27] = Me.OBJET '--- 'CALENDRIER If Not Intersect([C13], Target) Is Nothing And Target.Count = 1 Then Me.CALENDRIER.Height = Target.Height + 3 Me.CALENDRIER.Width = Target.Width Me.CALENDRIER.Top = Target.Top Me.CALENDRIER.Left = Target.Left Me.CALENDRIER = Target Me.CALENDRIER.Visible = True Me.CALENDRIER.Value = Now ActiveWindow.SmallScroll Down:=20 ActiveWindow.SmallScroll Down:=-20 Me.CALENDRIER.Activate ' Me.CALENDRIER.DropDown ' If Target <> "" Then SendKeys "{esc}" Else Me.CALENDRIER.Visible = False End If [C13] = Me.CALENDRIER 'TYPE DE REGLEMENT If [A27].Value = "Règlement par virement" Then Me.CHEQUE.Clear Else If Not Intersect([C27], Target) Is Nothing And Target.Count = 1 Then selectCHEQUE = Application.Transpose(Sheets("Paramétrages_Fiche").Range("CHEQUE").Value) Set d1 = CreateObject("Scripting.Dictionary") For Each c In selectCHEQUE If c <> "" Then d1(c) = "" Next c TblSelectCHEQUE = d1.keys Me.CHEQUE.List = d1.keys Me.CHEQUE.Height = Target.Height + 3 Me.CHEQUE.Width = Target.Width Me.CHEQUE.Top = Target.Top Me.CHEQUE.Left = Target.Left Me.CHEQUE = Target Me.CHEQUE.Visible = True Me.CHEQUE.Activate 'If Target <> "" Then SendKeys "{esc}" Else Me.CHEQUE.Visible = False End If End If [C27] = Me.CHEQUE End Sub Private Sub TYPEFNR_Change() If Me.TYPEFNR <> "" And IsError(Application.Match(Me.TYPEFNR, Sheets("Paramétrages_Fiche").Range("TYPEFNR").Value, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = UCase(Me.TYPEFNR) & "*" For Each c In TblChoix1 If UCase(c) Like tmp Then d1(c) = "" Next c Me.TYPEFNR.List = d1.keys Me.TYPEFNR.DropDown End If [C25] = Me.TYPEFNR ': ActiveCell.Offset(, 1) = "": ActiveCell.Offset(, 2) = "" End Sub Private Sub TYPEDEP_Change() If Me.TYPEDEP <> "" And IsError(Application.Match(Me.TYPEDEP, Sheets("Paramétrages_Fiche").Range("TYPEDEP").Value, 0)) Then Set d1 = CreateObject("Scripting.Dictionary") tmp = UCase(Me.TYPEDEP) & "*" For Each c In TblChoix2 If UCase(c) Like tmp Then d1(c) = "" Next c Me.TYPEDEP.List = d1.keys Me.TYPEDEP.DropDown End If [C26] = Me.TYPEDEP ': ActiveCell.Offset(, 1) = "" End Sub '''''''Private Sub OBJET_Change() ''''''' ''''''' If Me.OBJET <> "" And IsError(Application.Match(Me.OBJET, Sheets("Paramétrages_Fiche").Range("OBJET").Value, 0)) Then ''''''' Set d1 = CreateObject("Scripting.Dictionary") ''''''' tmp = UCase(Me.OBJET) & "*" ''''''' For Each c In TblChoix3 ''''''' If UCase(c) Like tmp Then d1(c) = "" ''''''' Next c ''''''' Me.OBJET.List = d1.keys ''''''' Me.OBJET.DropDown ''''''' End If ''''''' [C27] = Me.TYPEDEP = Me.OBJET '''''''End Sub Private Sub TYPEFNR_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.TYPEFNR.List = TblChoix1 Me.TYPEFNR.Activate Me.TYPEFNR.DropDown End Sub Private Sub TYPEDEP_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.TYPEDEP.List = TblChoix2 Me.TYPEDEP.Activate Me.TYPEDEP.DropDown End Sub ''''''' '''''''Private Sub OBJET_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ''''''' Me.OBJET.List = TblChoix3 ''''''' Me.OBJET.Activate ''''''' Me.OBJET.DropDown '''''''End Sub Private Sub TYPEFNR_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(, 1).Select End Sub Private Sub TYPEDEP_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End Sub ''''''' '''''''Private Sub OBJET_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ''''''' If KeyCode = 13 Then ActiveCell.Offset(1).Select '''''''End Sub Private Sub DR_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(, 1).Select End Sub

ucfoutu · Answer

Bonjour,
Je ne vais tout de même pas analyser toutes ces lignes de code.
Je vais me contenter de quelques indications générales :
1) il est toujours plus sage de générer le projet dans la version la plus basse (cela se fait par Ficher ===>> Enregistrer sous ===>> choisir la version la plus basse possible). Elle sera ainsi acceptée par  les versions éventuellement antérieures
2) un projet VBA/Excel fait sur PC n'est pas portable en l'état sur un MAC
3) les références cochées nécessaires doivent l'être sur toutes les machines

Marie · Answer

Bonsoir, 

Merci d'avoir pris le temps de répondre à ma question. 
Oui je comprends, plus qu'aisément, que vous ne souhaitez pas lire toutes ces lignes :)

Concernant les réponses : 
- 1 : je ne suis pas sure que ce soit le cas. Je vais essayer de reproduire le fichier ainsi. Cependant, même quand c'est le cas, le message 2 s'affiche. 
- 2 : nous n'utilisons pas Mac, mais merci pour l'info
- 3 : même quand cela est le cas, le message d'erreur s'affiche quand même (message 2)

D'où pensez vous que cela vienne ? 

Merci par avance pour vos réponses, 


Marie

ucfoutu · Answer

Je ne saurais te répondre.
Il y a trop, dans le code montré, d'utilisations :
- de propriétés "par défaut" de certains contrôles ...
- de "démarches" à coup de "select" 
 - de variables non typées
etc ...
Il ne m'est rigoureusement pas possible de suivre (voire de tenter de suivre sans une boîte d'aspirine et beaucoup de patience à portée de main) un code ainsi écrit par quelqu'un (qui ?) qui ne semble pas avoir la moindre idée de ce qu'est un "code propre" et "apte à la maintenance". . 
Je dirais sans la moindre hésitation que tout est à reprendre à zéro.

Fichier excel qui réagit différement selon les postes de travail

3 réponses

Discussions similaires