92 votes

Comment ajouter une référence de manière programmatique en utilisant VBA

J'ai écrit un programme qui s'exécute et envoie des messages Skype avec des informations lorsqu'il a terminé. J'ai besoin d'ajouter une référence pour Skype4COM.dll afin d'envoyer un message via Skype. Nous avons une douzaine d'ordinateurs sur un réseau et un serveur de fichiers partagé (entre autres choses). Tous les autres ordinateurs doivent être en mesure d'exécuter ce programme. J'espérais éviter de configurer la référence manuellement. J'avais prévu de placer la référence dans un emplacement partagé, et de l'ajouter de manière programmée lorsque le programme s'exécutait.

Je ne semble pas parvenir à comprendre comment ajouter une référence de manière programmée à Excel 2007 en utilisant VBA. Je sais comment le faire manuellement : Ouvrir VBE --> Outils --> Références --> parcourir --> Emplacement et Nom du Fichier. Mais cela n'est pas très utile pour mes besoins. Je sais qu'il existe des façons de le faire dans Access Vb.net et un code similaire à celui-ci ne cesse de s'afficher, mais je ne suis pas sûr de le comprendre, ou s'il est pertinent :

ThisWorkbook.VBProject.References.AddFromGuid _
    GUID:="{0002E157-0000-0000-C000-000000000046}", _
    Major:=5, Minor:=3

Jusqu'à présent, dans les solutions présentées, pour ajouter la référence de manière programmée, je devrai ajouter une référence manuellement et modifier le Centre de confiance - ce qui va au-delà de simplement ajouter la référence. Bien que je suppose que si je suis les solutions proposées, je pourrai ajouter des références futures de manière programmée. Ce qui en vaut probablement l'effort.

Toute pensée supplémentaire serait appréciée.

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.

117voto

Siddharth Rout Points 63935

Ommit

Il y a deux façons d'ajouter des références via VBA à vos projets

1) Utilisation du GUID

2) Référencement direct de la dll.

Permettez-moi de couvrir les deux.

Mais d'abord, voici 3 choses auxquelles vous devez faire attention

a) Les macros doivent être activées

b) Dans les paramètres de sécurité, assurez-vous que "Faire confiance à l'accès au projet Visual Basic" est coché

enter image description here

c) Vous avez défini manuellement une référence vers l'objet 'Microsoft Visual Basic pour les fonctionnalités d'Applications'

enter image description here

Méthode 1 (Utilisation du GUID)

J'évite généralement cette méthode car je dois rechercher le GUID dans le registre... ce que je déteste LOL. Plus sur GUID ici.

Sujet: Ajouter une bibliothèque de références VBA via du code

Lien: http://www.vbaexpress.com/kb/getarticle.php?kb_id=267

'Crédits: Ken Puls
Sub AddReference()
     'Objet de la macro:  Ajouter une référence au projet en utilisant le GUID pour la
     'bibliothèque de références

    Dim strGUID As String, theRef As Variant, i As Long

     'Mettre à jour le GUID nécessaire ci-dessous.
    strGUID = "{00020905-0000-0000-C000-000000000046}"

     'Définir pour continuer en cas d'erreur
    On Error Resume Next

     'Supprimer toutes les références manquantes
    For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
        Set theRef = ThisWorkbook.VBProject.References.Item(i)
        If theRef.isbroken = True Then
            ThisWorkbook.VBProject.References.Remove theRef
        End If
    Next i

     'Effacer toutes les erreurs afin que la gestion des erreurs pour les ajouts de GUID puisse être évaluée
    Err.Clear

     'Ajouter la référence
    ThisWorkbook.VBProject.References.AddFromGuid _
    GUID:=strGUID, Major:=1, Minor:=0

     'Si une erreur est rencontrée, informer l'utilisateur
    Select Case Err.Number
    Case Is = 32813
         'Référence déjà en cours d'utilisation. Aucune action nécessaire
    Case Is = vbNullString
         'Référence ajoutée sans problème
    Case Else
         'Une erreur inconnue a été rencontrée, informer l'utilisateur
        MsgBox "Un problème est survenu en essayant de" & vbNewLine _
        & "ajouter ou supprimer une référence dans ce fichier" & vbNewLine & "Veuillez vérifier les " _
        & "références de votre projet VBA!", vbCritical + vbOKOnly, "Erreur!"
    End Select
    On Error GoTo 0
End Sub

Méthode 2 (Référencement direct de la dll)

Ce code ajoute une référence à Microsoft VBScript Regular Expressions 5.5

Option Explicit

Sub AddReference()
    Dim VBAEditor As VBIDE.VBE
    Dim vbProj As VBIDE.VBProject
    Dim chkRef As VBIDE.Reference
    Dim BoolExists As Boolean

    Set VBAEditor = Application.VBE
    Set vbProj = ActiveWorkbook.VBProject

    '~~> Vérifier si "Microsoft VBScript Regular Expressions 5.5" est déjà ajouté
    For Each chkRef In vbProj.References
        If chkRef.Name = "VBScript_RegExp_55" Then
            BoolExists = True
            GoTo CleanUp
        End If
    Next

    vbProj.References.AddFromFile "C:\WINDOWS\system32\vbscript.dll\3"

CleanUp:
    If BoolExists = True Then
        MsgBox "La référence existe déjà"
    Else
        MsgBox "Référence ajoutée avec succès"
    End If

    Set vbProj = Nothing
    Set VBAEditor = Nothing
End Sub

Note: Je n'ai pas ajouté de gestion des erreurs. Il est recommandé d'utiliser dans votre code réel :)

ÉDIT Battu par mischab1 :)

2 votes

Il semble donc que au lieu d'ajouter la référence manuellement, je dois ajouter une référence séparée manuellement et changer les permissions Excel? Bien que ce soit une amélioration pour l'avenir, cela semble un peu amusant maintenant.

2 votes

Oui, cela semble drôle mais c'est comme ça pour le moment :)

1 votes

Super réponse. À noter que les utilisateurs de ceci peuvent toujours ne pas utiliser de mot / PowerPoint / autre objet ou Enum en dehors d'une fonction ou d'une procédure, car le compilateur échouera avant que l'événement WORKBOOK_OPEN ne commence à s'exécuter. Vous ne pouvez donc pas créer un objet Word public et vous ne pouvez pas définir le type d'un paramètre en tant que type Word/PPT (par exemple, vous ne pouvez pas faire quelque chose comme Sub CopierGraphiqueActifVersWord(FormatType en tant que WdPasteDataType)).

27voto

mischab1 Points 1018

Il existe deux façons d'ajouter des références en utilisant VBA. .AddFromGuid(Guid, Major, Minor) et .AddFromFile(Filename). La meilleure dépend de ce à quoi vous essayez d'ajouter une référence. Je utilise presque toujours .AddFromFile parce que les choses auxquelles je fais référence sont d'autres projets VBA Excel et qu'elles ne sont pas dans le Registre Windows.

L'exemple de code que vous montrez ajoutera une référence au classeur dans lequel se trouve le code. En général, je ne vois pas l'intérêt de le faire car 90% du temps, avant de pouvoir ajouter la référence, le code a déjà échoué à compiler parce que la référence est manquante. (Et s'il n'a pas échoué à compiler, vous utilisez probablement une liaison tardive et vous n'avez pas besoin d'ajouter de référence.)

Si vous rencontrez des problèmes pour exécuter le code, il peut y avoir deux problèmes possibles.

  1. Pour utiliser facilement le modèle d'objet de l'EDI VBE, vous devez ajouter une référence à Microsoft Visual Basic pour les applications Extensibilité. (VBIDE)
  2. Pour exécuter du code VBA Excel qui modifie quelque chose dans un projet VB, vous devez Faire confiance à l'objet modèle de projet VBA. (Dans Excel 2010, il se trouve dans le Centre de confiance - Paramètres Macro.)

En dehors de cela, si vous pouvez être un peu plus clair sur votre question ou sur ce que vous essayez de faire et qui ne fonctionne pas, je pourrais donner une réponse plus spécifique.

15voto

hennep Points 327

Naviguer dans le registre pour trouver des guides ou utiliser des chemins, quelle est la meilleure méthode ? Si la navigation dans le registre n'est plus nécessaire, n'est-ce pas la meilleure façon d'utiliser les guids ? Office n'est pas toujours installé dans le même répertoire. Le chemin d'installation peut être modifié manuellement. Le numéro de version fait également partie du chemin. Je n'aurais jamais pu prévoir que Microsoft ajouterait un jour '(x86)' à 'Program Files' avant l'introduction des processeurs 64 bits. Si possible, j'essaierais d'éviter d'utiliser un chemin d'accès.

Le code ci-dessous est dérivé de la réponse de Siddharth Rout, avec une fonction supplémentaire pour lister toutes les références qui sont utilisées dans le classeur actif. Que se passe-t-il si j'ouvre mon classeur dans une version ultérieure d'Excel ? Le classeur fonctionnera-t-il toujours sans adapter le code VBA ? J'ai déjà vérifié que les guides pour Office 2003 et 2010 sont identiques. Espérons que Microsoft ne change pas les guides dans les versions futures.

Les arguments 0,0 (de .AddFromGuid) devraient utiliser la dernière version d'une référence (ce que je n'ai pas pu tester).

Qu'en pensez-vous ? Bien sûr, nous ne pouvons pas prédire l'avenir, mais que pouvons-nous faire pour que notre code soit à l'épreuve des versions ?

Sub AddReferences(wbk As Workbook)
    ' Run DebugPrintExistingRefs in the immediate pane, to show guids of existing references
    AddRef wbk, "{00025E01-0000-0000-C000-000000000046}", "DAO"
    AddRef wbk, "{00020905-0000-0000-C000-000000000046}", "Word"
    AddRef wbk, "{91493440-5A91-11CF-8700-00AA0060263B}", "PowerPoint"
End Sub

Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String)
    Dim i As Integer
    On Error GoTo EH
    With wbk.VBProject.References
        For i = 1 To .Count
            If .Item(i).Name = sRefName Then
               Exit For
            End If
        Next i
        If i > .Count Then
           .AddFromGuid sGuid, 0, 0 ' 0,0 should pick the latest version installed on the computer
        End If
    End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & err.Description
    Resume EX
    Resume ' debug code
End Sub

Public Sub DebugPrintExistingRefs()
    Dim i As Integer
    With Application.ThisWorkbook.VBProject.References
        For i = 1 To .Count
            Debug.Print "    AddRef wbk, """ & .Item(i).GUID & """, """ & .Item(i).Name & """"
        Next i
    End With
End Sub

Le code ci-dessus n'a plus besoin de la référence à l'objet "Microsoft Visual Basic for Applications Extensibility".

3 votes

Notez que vous devez avoir les macros activées et vérifier que l'accès à Visual Basic Project est activé (points a et b dans la réponse de @Siddharth_Rout), mais +1 pour éliminer la référence VBIDE! De plus, j'apprécie que DebugPrintExistingRefs le mette dans le format pour copier et coller la ligne dans le code.

9voto

Chad Crowe Points 495

Voici comment obtenir les GUID de manière programmatique ! Vous pouvez ensuite utiliser ces guids/chemins de fichiers avec une réponse ci-dessus pour ajouter la référence !

Référence : http://www.vbaexpress.com/kb/getarticle.php?kb_id=278

Sub ListReferencePaths()
'Liste du chemin et du GUID (Identifiant Globalement Unique) pour chaque bibliothèque référencée.
'Sélectionnez une référence dans Outils > Références, puis exécutez ce code pour obtenir le GUID, etc.
    Dim rw As Long, ref
    With ThisWorkbook.Sheets(1)
        .Cells.Clear
        rw = 1
        .Range("A" & rw & ":D" & rw) = Array("Référence","Version","GUID","Chemin")
        For Each ref In ThisWorkbook.VBProject.References
            rw = rw + 1
            .Range("A" & rw & ":D" & rw) = Array(ref.Description, _
                   "v." & ref.Major & "." & ref.Minor, ref.GUID, ref.FullPath)
        Next ref
        .Range("A:D").Columns.AutoFit
    End With
End Sub

Voici le même code mais affiché dans le terminal si vous ne souhaitez pas dédier une feuille de calcul pour la sortie.

Sub ListReferencePaths() 
 'Objectif de la macro :  Déterminer le chemin complet et l'Identifiant Globalement Unique (GUID)
 'pour chaque bibliothèque référencée. Sélectionnez la référence dans Outils\Références
 'puis exécutez ce code pour obtenir les informations sur la bibliothèque de référence

On Error Resume Next 
Dim i As Long 

Debug.Print "Nom de la référence" & " | " & "Chemin complet de la référence" & " | " & "GUID de la référence" 

For i = 1 To ThisWorkbook.VBProject.References.Count 
  With ThisWorkbook.VBProject.References(i) 
    Debug.Print .Name & " | " & .FullPath  & " | " & .GUID 
  End With 
Next i 
On Error GoTo 0 
End Sub

-4voto

Mark Gittoes Points 103

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

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X