Voici le code que j'ai utilisé en VB.Net
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
' Start Excel and get Application object.
oXL = CreateObject("Excel.Application")
oXL.Visible = True
' Get a new workbook.
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
La classe ci-dessous produit une feuille de calcul Excel basée sur le contenu de deux tableaux de données. C'est VB.Net mais je crois que l'automatisation OLE est la même pour VBA.
Vous devez inclure des références
Interop.Microsoft.Office.Interop.Excel, Bibliothèque d'objets Microsoft Excel 14.0
Ce code est vieux de 8 ans, donc désolé qu'il y en ait autant, mais il comprend des corrections et des solutions de contournement utiles pour faire un travail correct.
'Option Strict Off to allow automation of MS Office components
Option Strict Off
Imports System.IO
Imports Microsoft.Office.Core
Public Class ResultXls
'///////////
' Variables
'///////////
Private Const _ReportName = "Result"
Enum WorksheetRows
EventTitle = 1
RaceTitle
RaceDate
ResultsHeader
ResultsData
End Enum
'Pos, Boat No, Boat Name, Driver, Navigator, Laps, Time, NMiles, Miles, Km, Knots, Mph, Kmph, Points
Enum BoatHeadings
Pos
BoatNo
BoatName
Driver
Navigator
Laps
Time
NMiles
Miles
Km
Knots
Mph
Kmph
Points
End Enum
'Class variables
Private _RaceDb As RaceDb
Public Sub New(ByVal RaceDB As RaceDb)
_RaceDb = RaceDB
End Sub
'///////////////////
' Public Procedures
'///////////////////
Public Sub CreateExcelWorksheet(ByVal RaceId As Integer)
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
'Load datatables
Dim RaceDataTable As DataTable = _RaceDb.GetRaceInfoDataTable(RaceId)
Dim RaceResultDataTable As DataTable = _RaceDb.GetRaceResultsDataTable(RaceId)
' Start Excel and get Application object.
oXL = CreateObject("Excel.Application")
oXL.Visible = True
' Get a new workbook.
oWB = oXL.Workbooks.Add
oSheet = oWB.ActiveSheet
'************
' Page Setup
'************
'oSheet.Name = Convert.ToDateTime(RaceDataTable.Rows(0)("RaceDate")).ToString("yyyy-MM-dd") + " - " + RaceDataTable.Rows(0)("RaceName").ToString() + " - " + RaceDataTable.Rows(0)("RaceClass").ToString()
oSheet.PageSetup.Orientation = Excel.XlPageOrientation.xlLandscape
oSheet.PageSetup.FitToPagesWide = 1
oSheet.PageSetup.FitToPagesTall = 1
oSheet.PageSetup.CenterHorizontally = True
'******************
' Results Headings
'******************
'Pos, Boat No, Boat Name, Driver, Navigator, Laps, Time, NMiles, Miles, Km, Knots, Mph, Kmph, Points
'Set headings
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Pos + 1).Value = "Pos"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.BoatNo + 1).Value = "Number"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.BoatName + 1).Value = "Boat"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Driver + 1).Value = "Driver"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Navigator + 1).Value = "Navigator"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Laps + 1).Value = "Laps"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Time + 1).Value = "Time"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.NMiles + 1).Value = "NMiles"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Miles + 1).Value = "Miles"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Km + 1).Value = "Km"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Knots + 1).Value = "Knots"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Mph + 1).Value = "Mph"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Kmph + 1).Value = "Kmh"
oSheet.Cells(WorksheetRows.ResultsHeader, BoatHeadings.Points + 1).Value = "Points"
'Format headings
Dim headingRange As Excel.Range = oSheet.Range("A" + Convert.ToString(WorksheetRows.ResultsHeader), "N" + Convert.ToString(WorksheetRows.ResultsHeader))
headingRange.Font.Name = "Arial"
headingRange.Font.Size = 10
headingRange.Font.Bold = True
headingRange.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
headingRange.Borders.LineStyle = Excel.XlLineStyle.xlContinuous
headingRange.Borders.Weight = Excel.XlBorderWeight.xlThin
'**************
' Results Data
'**************
'Pos, Boat No, Boat Name, Driver, Navigator, Laps, Time, NMiles, Miles, Km, Knots, Mph, Kmph, Points
'Load boat data
Dim boat As Integer
Dim datarow As DataRow
For boat = 0 To RaceResultDataTable.Rows.Count - 1
'BoatHeadings.Pos '"Position", "Pos"
'BoatHeadings.BoatNo '"BoatNumberText", "Number"
'BoatHeadings.BoatName '"BoatName", "Boat"
'BoatHeadings.Driver '"Driver", "Driver"
'BoatHeadings.Navigator '"Navigator", "Navigator"
'BoatHeadings.Laps '"TotalLapsCompleted", "Laps"
'BoatHeadings.Time '"RaceElapsedTimeHHMMSS", "Time"
'BoatHeadings.NMiles '"CompletedNm", "NMiles"
'BoatHeadings.Miles '"CompletedMiles", "Miles"
'BoatHeadings.Km '"CompletedKm", "Km"
'BoatHeadings.Knots '"RaceSpeedKnots", "Knots"
'BoatHeadings.Mph '"RaceSpeedMph", "Mph"
'BoatHeadings.Kmph '"RaceSpeedKmh", "Kmh"
'BoatHeadings.Points '"Points", "Points"
datarow = RaceResultDataTable.Rows(boat)
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Pos + 1).Value = datarow("Position")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.BoatNo + 1).Value = datarow("BoatNumberText")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.BoatName + 1).Value = datarow("BoatName")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Driver + 1).Value = datarow("Driver")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Navigator + 1).Value = datarow("Navigator")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Laps + 1).Value = datarow("TotalLapsCompleted")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Time + 1).Value = datarow("RaceElapsedTimeHHMMSS")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.NMiles + 1).Value = datarow("CompletedNm")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Miles + 1).Value = datarow("CompletedMiles")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Km + 1).Value = datarow("CompletedKm")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Knots + 1).Value = datarow("RaceSpeedKnots")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Mph + 1).Value = datarow("RaceSpeedMph")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Kmph + 1).Value = datarow("RaceSpeedKmh")
oSheet.Cells(WorksheetRows.ResultsData + boat, BoatHeadings.Points + 1).Value = datarow("Points")
Next
'Format columns
Dim range As Excel.Range
'Time
range = oSheet.Range("G" + Convert.ToString(WorksheetRows.ResultsData), "G" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "hh:mm:ss.00"
'NMiles
range = oSheet.Range("H" + Convert.ToString(WorksheetRows.ResultsData), "H" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Miles
range = oSheet.Range("I" + Convert.ToString(WorksheetRows.ResultsData), "I" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Km
range = oSheet.Range("J" + Convert.ToString(WorksheetRows.ResultsData), "J" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Knots
range = oSheet.Range("K" + Convert.ToString(WorksheetRows.ResultsData), "J" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Mph
range = oSheet.Range("L" + Convert.ToString(WorksheetRows.ResultsData), "L" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Kmph
range = oSheet.Range("M" + Convert.ToString(WorksheetRows.ResultsData), "M" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.NumberFormat = "0.00"
'Format results data
Dim resultsRange As Excel.Range = oSheet.Range("A" + Convert.ToString(WorksheetRows.ResultsData), "N" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
resultsRange.Borders.LineStyle = Excel.XlLineStyle.xlContinuous
resultsRange.Borders.Weight = Excel.XlBorderWeight.xlHairline
resultsRange.EntireColumn.AutoFit()
'Points
range = oSheet.Range("N" + Convert.ToString(WorksheetRows.ResultsData), "N" + Convert.ToString(Convert.ToString(WorksheetRows.ResultsData + RaceResultDataTable.Rows.Count - 1)))
range.Borders.LineStyle = Excel.XlLineStyle.xlContinuous
range.Borders.Weight = Excel.XlBorderWeight.xlThin
'********
' Titles
'********
'Add titles last so that AutoFit format is not affected
'RaceId, RaceYear, RaceNumber, RaceName, RaceDate, RaceClass, LapNMiles, LapMiles, LapKm, RaceLaps, RaceStartDateTime, RaceEndDateTime
'EventTitle
oSheet.Cells(WorksheetRows.EventTitle, 1).Value = Convert.ToString(RaceDataTable.Rows(0)("EventTitle"))
Dim racenameRange As Excel.Range = oSheet.Range("A" + Convert.ToString(WorksheetRows.EventTitle), "N" + Convert.ToString(WorksheetRows.EventTitle))
racenameRange.Font.Name = "Arial"
racenameRange.Font.Size = 12
racenameRange.Font.Bold = True
racenameRange.Merge()
racenameRange.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
'RaceTitle
oSheet.Cells(WorksheetRows.RaceTitle, 1).Value = Convert.ToString(RaceDataTable.Rows(0)("RaceTitle"))
Dim classnameRange As Excel.Range = oSheet.Range("A" + Convert.ToString(WorksheetRows.RaceTitle), "N" + Convert.ToString(WorksheetRows.RaceTitle))
classnameRange.Font.Name = "Arial"
classnameRange.Font.Size = 12
classnameRange.Font.Bold = True
classnameRange.Merge()
classnameRange.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
'Date
oSheet.Cells(WorksheetRows.RaceDate, 1).Value = "'" + Convert.ToDateTime(RaceDataTable.Rows(0)("RaceDate")).ToString("dd MMM yyyy ddd")
Dim racedateRange As Excel.Range = oSheet.Range("A" + Convert.ToString(WorksheetRows.RaceDate), "A" + Convert.ToString(WorksheetRows.RaceDate))
racedateRange.Font.Name = "Arial"
racedateRange.Font.Size = 12
racedateRange.Font.Bold = True
racedateRange.HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft
'Laps
Dim totalLaps As Integer = NullInt(RaceDataTable.Rows(0)("StartLaps")) + NullInt(RaceDataTable.Rows(0)("RaceLaps")) + NullInt(RaceDataTable.Rows(0)("PitLaps"))
oSheet.Cells(WorksheetRows.RaceDate, 14).Value = Convert.ToString(totalLaps) + " Laps"
Dim racelapsRange As Excel.Range = oSheet.Range("N" + Convert.ToString(WorksheetRows.RaceDate), "N" + Convert.ToString(WorksheetRows.RaceDate))
racelapsRange.Font.Name = "Arial"
racelapsRange.Font.Size = 12
racelapsRange.Font.Bold = True
racelapsRange.HorizontalAlignment = Excel.XlHAlign.xlHAlignRight
'**********
' Clean Up
'**********
'Make Excel visible and give the user control of Excel's lifetime
oXL.Visible = True
oXL.UserControl = True
'Save
Dim dateText As String = Convert.ToDateTime(RaceDataTable.Rows(0)("RaceDate")).ToString("yyyy-MM-dd")
Dim dayText As String = Left(Convert.ToDateTime(RaceDataTable.Rows(0)("RaceDate")).DayOfWeek.ToString(), 3)
Dim eventText As String = RaceDataTable.Rows(0)("EventTitle").ToString()
Dim raceText As String = RaceDataTable.Rows(0)("RaceTitle").ToString()
Dim filename = String.Format("{0} {1} {2} {3} {4}", dateText, dayText, eventText, raceText, _ReportName)
Try
oWB.SaveAs(filename:=filename)
Catch ex As Exception
MessageBox.Show("Failed to save report", "Save Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1)
End Try
'Release object references
oRng = Nothing
oSheet = Nothing
oWB = Nothing
'oXL.Quit()
oXL = Nothing
GC.Collect()
End Sub
End Class
3 votes
Vous pouvez utiliser CreateObject() sans ajouter de référence sous Excel 2010
2 votes
Aucune idée pourquoi cela resurgit - mais jetez un coup d'œil à l'early/bindage tardif. Si vous ajoutez une référence (soit manuellement, soit de manière programmatique), elle lie votre code à une version spécifique. Par exemple, la bibliothèque Excel 11 est liée à Excel 2003. C'est bien si c'est ce que vous voulez, mais très souvent (surtout là où je travaille), j'ai besoin que cela fonctionne sur 2003, 2007 et 2010.