activeX et mac, message d'erreur

gosselien

XLDnaute Barbatruc
Bonjour,

j'ai mis en route l'excellent code (doublons2colonnes) de J. Boisgontier sur Excel 2010 MAC et j'ai un message d'erreur disant: "un composant activeX ne peut pas créer d'objet"

Comment faire alors sur un mac ?

Merci aux Mac User
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : activeX et mac, message d'erreur

Bonjour,

Pour simuler Dictionary qui n'existe pas sur Mac, on peut utiliser un module de classe.
Hélas, les performances ne seront pas les mêmes.

-Version utilisant les tableaux
-Version utilisant les collections

http://boisgontierjacques.free.fr/fichiers/Cellules/ClasseDictionnaire.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/ClasseDictionnaireCollection.xls

Pour 4.500 items

1,5 s avec les tableaux
0,28 s avec les collections

Code:
Sub ColoriageDoublons2col()
  Set d1 = New Dictionnaire
  Set d2 = New Dictionnaire
  Set plage1 = Range("A2", [a65000].End(xlUp))
  Set plage2 = Range("B2", [B65000].End(xlUp))
  [A:B].Interior.ColorIndex = xlNone
  For Each c In plage1
    If c <> "" Then d1.ajout(c.Value) = ""
  Next c
  For Each c In plage2
    If d1.Existe(CStr(c.Value)) Then c.Interior.ColorIndex = 3
    If c.Value <> "" Then d2.ajout(CStr(c.Value)) = ""
  Next c
  For Each c In plage1
    If d2.Existe(CStr(c.Value)) Then c.Interior.ColorIndex = 4
  Next c
End Sub

Liste sans doublons


Code:
Sub ListeSansDoublons()
  Set d1 = New Dictionnaire
  Set plage1 = Range("A2", [a65000].End(xlUp))
  For Each c In plage1
    If c <> "" Then d1.ajout(c.Value) = ""
  Next c
  '---- transfert dans le tableur
  Set plg = Range("d2").Resize(d1.count)
  plg.Value = d1.listeCles
  '------- transfert dans un tableau b(,)
  b = d1.listeCles
  For i = LBound(b) To UBound(b)
     Cells(i + 1, "c") = b(i, 1)
  Next i
  '---  Accès aux clés par un indice
  For i = 1 To d1.count
   Cells(i + 1, "c") = d1.cle(i)
  Next i
End Sub


Module de classe Dictionnaire

Code:
Private xn
Private Collec As New Collection
Private CollecCle As New Collection

Public Property Let ajout(cle, item)
  On Error Resume Next
  Collec.Add item:=item, Key:=cle
  CollecCle.Add item:=cle, Key:=cle
  If Err = 0 Then xn = xn + 1
End Property

Public Property Get count()
  count = xn
End Property

Public Property Get listeItems()
  Dim temp()
  ReDim temp(1 To xn)
  For i = 1 To xn
    temp(i) = Collec(i)
  Next i
  listeItems = Application.Transpose(temp)
End Property

Public Property Get listeCles()
  Dim temp()
  ReDim temp(1 To xn)
  For i = 1 To xn
    temp(i) = CollecCle(i)
  Next i
  listeCles = Application.Transpose(temp)
End Property

Public Property Get item(cle)
  item = Collec(cle)
End Property

Public Property Get Existe(cle)
  On Error Resume Next
  retour = Collec(cle)
  Existe = (Err = 0)
End Property

Public Property Get cle(indice)
  If indice <= xn Then cle = CollecCle(indice) Else cle = ""
End Property

JB
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
352
Réponses
4
Affichages
296
Compte Supprimé 979
C
Réponses
9
Affichages
575

Statistiques des forums

Discussions
312 103
Messages
2 085 317
Membres
102 862
dernier inscrit
Emma35400