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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
| Public Sub RemplirFeuille()
' ======================================================================================
' INSPIRED BY :
' Auteur : Starec - Philippe JOCHMANS - http://starec.developpez.com
' Description : Cette routine va nous permettre de remplir la feuille
'=======================================================================================
' ===== déclaration =====
' Classeur et feuille externe à la base
Dim sFichierExcel As String
Dim sNomFeuille As String
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim lPremLig As Long
Dim lDernLig As Long
Dim lDerColl As Long
Dim lSize As Double
Dim i As Long, j As Integer
' Classeur ActiveX
Dim wks As OWC11.Spreadsheet
' Classeur et feuille à charger
sFichierExcel = "D:\Classeur1.xlsx"
sNomFeuille = "Feuil1"
' ===== affectation =====
Set wks = Me.SpreadMFC.Object
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(sFichierExcel)
Set xlSheet = xlBook.Sheets(sNomFeuille)
xlSheet.Activate
lDernLig = xlSheet.Cells(xlSheet.Cells.Rows.Count, 1).End(xlUp).Row
lDerColl = xlSheet.Cells(lDernLig, 1).End(xlToRight).Column
' 1ère ligne = 1
lPremLig = 1
' ===== on vide la feuille de l'objet SpreadSheet =====
wks.Cells.delete
' on y ajoute le nombre de colonnes de la feuille externe - 1
For i = 1 To lDerColl - 1
wks.Cells(i).Activate
wks.ActiveCell.EntireColumn.Select
wks.Selection.Insert
Next i
wks.Windows(1).FreezePanes = False
wks.Application.ScreenUpdating = False
' ===== remplissage de la feuille =====
For i = 1 To lDernLig
For j = 1 To lDerColl
wks.Cells(i, j) = xlSheet.Cells(i, j)
' on suppose que la ligne 1 est l'entête
If i = lPremLig Then
wks.Cells(i, j).Interior.Color = RGB(220, 200, 250)
lSize = lSize + xlSheet.Cells(1, j).Width
End If
Next j
Next i
wks.Range("A2").Select
wks.Windows(1).FreezePanes = True
' ===== formatage de la feuille =====
With wks.Range(wks.Cells(lPremLig, 1), wks.Cells(lDernLig, lDerColl))
.Columns.AutoFit
.Borders.LineStyle = xlContinuous
End With
' ===== formatage de l'objet =====
Me.SpreadMFC.Width = (lSize * 20)
' ===== libération =====
wks.Application.ScreenUpdating = True
xlBook.Close
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set wks = Nothing
End Sub |
Partager