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

- - Dernière réponse : ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
- 1 févr. 2016 à 19:03
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

Afficher la suite 

3 réponses

Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
209
0
Merci
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
0
Merci
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
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
209
0
Merci
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.