1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
|
1.Private Sub CommandButton1_Click()
2.
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
7.
8.Fichier = "h:\monfichierferme.xls"
9.
10.Set XlConnect = CreateObject("ADODB.Connection" )
11. Set XlCatalog = CreateObject("ADOX.Catalog" )
12.
13.XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
14. ";Extended Properties=Excel 8.0;"
15. Set XlCatalog.ActiveConnection = XlConnect
16.
17.Cells(1, 1).Select
18.
19.'je ne récupére que les noms qui se terminent par "$"
20.
21.For Each Feuille In XlCatalog.Tables
22. If UCase(Right(Feuille.Name, 1)) = "$" Then
23. ActiveCell = Feuille.Name
24.
25.
26.'et suprime le "$"
27.
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
33.
34.ActiveCell.Offset(1, 0).Select
35.
36.End If
37.
38.Next
39.
40.End Sub |
Partager