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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
| Option Explicit
Private TabFichier As Variant
Private TabCritere As Variant
Public Sub RemplirTabCritere()
End Sub
Public Sub ImporterXLS()
Dim TabFichier As Variant
Dim Xl As Excel.Application
Dim i As Integer
Dim j As Integer
Dim FinFichier As Boolean
i = 0
j = 1
FinFichier = False
Set Xl = New Excel.Application
Xl.Workbooks.Open App.Path & "\Liste.xls"
Xl.Sheets.Select 1
While FinFichier = False
If j = 1 Then
ReDim TabFichier(21, 0)
Else
ReDim Preserve TabFichier(21, i + 1)
End If
i = UBound(TabFichier, 2)
TabFichier(0, i) = Xl.Range("A" & (j + 1)).Value
TabFichier(1, i) = Xl.Range("B" & (j + 1)).Value
TabFichier(2, i) = Trim(Xl.Range("C" & (j + 1)).Value)
TabFichier(3, i) = CDate(Xl.Range("D" & (j + 1)).Value)
TabFichier(4, i) = CDbl(Xl.Range("E" & (j + 1)).Value)
TabFichier(5, i) = CDbl(Xl.Range("F" & (j + 1)).Value)
TabFichier(6, i) = CDbl(Xl.Range("G" & (j + 1)).Value)
TabFichier(7, i) = CDbl(Xl.Range("H" & (j + 1)).Value)
j = j + 1
If Xl.Range("A" & (j + 1)) = "" And Xl.Range("B" & (j + 1)) = "" And _
Xl.Range("C" & (j + 1)) = "" And Xl.Range("D" & (j + 1)) = "" And _
Xl.Range("E" & (j + 1)) = "" And Xl.Range("F" & (j + 1)) = "" And _
Xl.Range("G" & (j + 1)) = "" And Xl.Range("H" & (j + 1)) = "" Then
FinFichier = True
End If
Wend
Xl.Quit
Set Xl = Nothing
End Sub
Private Sub Command1_Click()
ImporterXLS
End Sub |
Partager