Importer noms feuilles d'un classseur fermé

Importer noms feuilles d'un classseur fermé - VB/VBA/VBS - Programmation

Marsh Posté le 18-11-2012 à 09:40:00    

Bonjour,
J'ai besoin d'importer la liste des noms de feuilles de mon classeur fermé dans des cellules de mon classeur ouvert et pour cela j'ai fait ceci (je n'ai rien inventé...)
 

Code :
  1. Private Sub CommandButton1_Click()
  3. Dim XlConnect As Object, XlCatalog As Object
  4. Dim Fichier As String, Resultat As String
  5. Dim Feuille As Object
  6. Dim objCell As Range
  8. Fichier = "h:\monfichierferme.xls"
  10. Set XlConnect = CreateObject("ADODB.Connection" )
  11. Set XlCatalog = CreateObject("ADOX.Catalog" )
  13. XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
  14. ";Extended Properties=Excel 8.0;"
  15. Set XlCatalog.ActiveConnection = XlConnect
  17. Cells(1, 1).Select
  19. 'je ne récupére que les noms qui se terminent par "$"
  21. For Each Feuille In XlCatalog.Tables
  22. If UCase(Right(Feuille.Name, 1)) = "$" Then
  23. ActiveCell = Feuille.Name
  26. 'et suprime le "$"
  28. For Each objCell In Selection
  29.      If Right(objCell.Value, 1) = "$" Then
  30.          objCell.Value = Left(objCell.Value, Len(objCell.Value) - 1)
  31.      End If
  32. Next objCell
  34. ActiveCell.Offset(1, 0).Select
  36. End If
  38. Next
  40. End Sub


 ce code fonctionne parfaitement sous excel 2003 ou 2010 mais bug sous 2000 avec un message d'erreur:
 "projet ou bibliothéque introuvable" et surligne de cette façon la ligne
 
If UCase(Right(Feuille.Name, 1)) = "$" Then
 
que me faut-il modifier pour que cela fonctionne svp ?
 s' agit-il de Microsoft office 11.0 object library coché d'un coté et Microsoft office 9.0 object library de l'autre dans les références ?
 puis-je contourner le pobléme ?
 
Un grand merci pour vos réponses

Reply

Marsh Posté le 18-11-2012 à 09:40:00   

Reply

Marsh Posté le 19-11-2012 à 07:17:27    

Bonjour,
Tu as mis Right en gras, c'est lui qui pose problème ?
Si c'est le cas, essaye en remplaçant Right par vba.Right.
 
Sinon, essaye de voir qu'est-ce qui pose problème sur ta ligne en la remplaçant à chaque fois comme ça :
1) If Feuille.Name = "$" Then
2) If Right(Feuille.Name, 1) = "$" Then
3) If UCase(Feuille.Name) = "$" Then
 
Par élimination, tu saura ce qui pose problème.


---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Marsh Posté le 19-11-2012 à 15:06:23    

Bonjour,
Merci oovaveoo , au final je suis arrivé à ce résultat qui fonctionne dans tous les cas de figure.
reste un cas particulier à gérer qui est le suivant:
quand je lance ma macro fichier fermé tout est ok et j'ai bien la liste des feuilles visibles avec leur nom propre par contre si d'aventure le fichier se trouve être ouvert alors viennent aussi s'ajouter les feuilles cachées(en hidden), ce que je ne souhaite pas.

Code :
  1. Private Sub CommandButton1_Click()
  2. Dim XlConnect As Object, XlCatalog As Object
  3. Dim Fichier As String, Resultat As String
  4. Dim Feuille As Object
  7. Fichier = "h:\monfichierferme.xls"
  10. Set XlConnect = CreateObject("ADODB.Connection" )
  11. Set XlCatalog = CreateObject("ADOX.Catalog" )
  13. XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
  14. ";Extended Properties=Excel 8.0;"
  15. Set XlCatalog.ActiveConnection = XlConnect
  17. Cells(1, 1).Select
  19. 'je teste si le nom de chaque feuille se termine par $ ou par $' et si oui l'importe dans ma ellule
  20. For Each Feuille In XlCatalog.Tables
  21. If UCase(Right(Feuille.Name, 1)) = "$" Or UCase(Right(Feuille.Name, 2)) = "$'" Then
  22. ActiveCell.Value = nom
  23. ActiveCell = Feuille.Name
  25. 'je reprend chaque valeur et si elle se termine par $ je suprime 1 caractére à la fin
  26. 'si elle se termine par $' je suprime 2 caractéres à la fin
  27. Dim objCell As Range
  29. For Each objCell In Selection
  31.     If Right(objCell.Value, 1) = "$" Then
  32.         objCell.Value = Left(objCell.Value, Len(objCell.Value) - 1)
  33.     End If
  34.     If Right(objCell.Value, 2) = "$'" Then
  35.         objCell.Value = Left(objCell.Value, Len(objCell.Value) - 2)
  36.     End If
  37.    
  38. Next objCell
  40. ActiveCell.Offset(1, 0).Select
  42. End If
  44. Next
  46. End Sub


 
 :hello:

Reply

Marsh Posté le 19-11-2012 à 15:11:05    

Tu peux tester si la feuille est visible :

Code :
  1. if sheets(Feuille.Name).visible then


---------------
Bel ours Vave, je me dois de l’admettre. -Skyl"win"-  Mais toi tu es intelligent -Homerde- - Ce génie -SkylWINd- JDD S16M72 10:43:46 GMT-DTC +1
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed