Référence à un fichier Excel

Ajouter la référence à Excel:

Mettre dans les déclarations du module (ou de la feuille en tant que Dim)
Global MonAppWorld As Excel.Application
Global MonWbWorld As Excel.Workbook
Global MesFeuillesXls(1 To 20) As String

Ouvrir Excel:
Sub XlsSetup()
   Dim MaXlsFeuille As Excel.Worksheet
    On Error Resume Next ‘ignore errors
    Set MonAppWorld = GetObject(, « Excel.Application ») ‘rechercher une copie d’Excel en cours
    If Err Then ‘Si Excel n’est pas en cours
        Err.Clear
        Set MonAppWorld = CreateObject(« Excel.Application ») ‘le lancer
        If Err Then MsgBox « Erreur XlsSetup, CreateObject ‘Excel.application’   » & Error$
    End If    

    Err.Clear   ‘ Effacer l’objet Err en cas d’erreur.
    Set MonWbWorld = MonAppWorld.Workbooks.Open(MonFicXls)
    If Err Then MsgBox  » Erreur XlsSetup, Open  » & MonFicXls &  »    » & Error$    

    Err.Clear
    ‘ Parcourt la collection de feuilles et ajoute
    ‘ le nom de chaque feuille dans la liste déroulante.
    For Each MaXlsFeuille In MonWbWorld.Sheets
        Ii = Ii + 1
        MesFeuillesXls(Ii) = MaXlsFeuille.Name
    Next MaXlsFeuille
    On Error GoTo 0
    Set MaXlsFeuille = Nothing
End Sub

Faire le traitement:
Sub RécupèreProdDuJour(ByVal MaDate As String, MaMachine As String)
    Dim MaXlsFeuille As Excel.Worksheet
    Dim MonXlsChamp As Excel.Range
    Dim MaLigne As Integer                  ‘Ligne de Excel dans laquelle on écrit
    Dim MaColonne As Integer                ‘Colonne de Excel dans laquelle on écrit
    Dim NbJours As Integer, TmpMois As String

    MaDate = Left$(MaDate, 2)    

    If MonAppWorld Is Nothing Then XlsSetup

    ‘————————————————————————————————————-
    Err.clear: On Error Resume Next
    Set MaXlsFeuille = MonWbWorld.Sheets(MaMachine)
    If Err Then MsgBox « Erreur dans SauveSurExcel, Set MaXlsFeuille    » & Error$
    On Error GoTo 0    

    Set MonXlsChamp = MaXlsFeuille.Rows(1)    

    ‘Recherche de la colonne Excel qui nous interesse (en fonction de la date à lire)
    MaColonne = 0
    Dim MaCase
    For j = 3 To 33
        Tmp = MonXlsChamp.Cells(4, j)
        If Right$(Format$(Tmp, « 00 »), 2) = MaDate Then
            MaColonne = j
            For MaLigne = 5 To 50
                If MonXlsChamp.Cells(MaLigne, 1) = «  » Then Exit For
                If Val(MonXlsChamp.Cells(MaLigne, MaColonne)) > 0 Then
                    macouleur = MonXlsChamp.Cells(MaLigne, MaColonne).Interior.Color
                End If
            Next MaLigne
            Exit For
        End If
    Next j    

    ‘————————————————————————————————————-
    ‘ Nettoie.
    Set MaXlsFeuille = Nothing
    Set MonXlsChamp = Nothing
End Sub

Fermer Excel:
Sub XlsClose()
    ‘ Ceci doit forcer un déchargement de Microsoft Excel,
    ‘ à conditon qu’aucune autre application ou aucun autre utilisateur ne l’ait chargé.
    Err.Clear: On Error Resume Next
    MonWbWorld.Close True
    Set MonWbWorld = Nothing
    Set MonAppWorld = Nothing
    On Error GoTo 0
End Sub

Copie d'une portion de grille dans le presse-papier

Private Sub Grid_KeyPress(KeyAscii As Integer)
    If KeyAscii = 3 Then ‘Touche <Ctrl C>
        Dim Sep As String, Tmp As String
        Clipboard.Clear        

        ‘————————-Header de la grille
        For j = Grid.Col To Grid.ColSel
            Tmp = Tmp & Sep & Grid.TextMatrix(0, j)
            Sep = vbTab
        Next j
        Sep = vbCrLf        

        ‘————————-Partie de la grille qui est sélectionnée
        For i = Grid.Row To Grid.RowSel
            For j = Grid.Col To Grid.ColSel
                Tmp = Tmp & Sep & Grid.TextMatrix(i, j)
                Sep = vbTab
            Next j
            If Tmp <> «  » Then Tmp = Tmp & vbCrLf
            Sep = «  »
        Next i
    End If
    Clipboard.SetText Tmp
End Sub

Conversion d'une table Access en feuille Excel

Cet exemple, pompé en 10 min d’après le prog d’arrachement, est brut et sert à créer un fichier Excel « Etiq.xls » comportant une feuille « Etiquette » contenant tous les enregistrements de la table « Etiquette » de la Bdd « Etiq.mdb ».

Attention: pour que ça fonctionne, il faut que la feuille « Etiquette » du fichier Excel n’existe pas.

Dans la zone déclaration d’une feuille (ou d’un module)

Dim Ws As Workspace

Dans la procédure d’un contrôle (par exemple)

Private Sub Command1_Click()
    Dim Bdd As String
    Dim Xls As String
    Bdd = « D:\documents and Settings\ebap188\My Documents\etiq.mdb »
    Xls = Replace(Bdd, « .mdb », « .xls »)    

    Dim DataBdd As Database
    Dim DataXls As Database    

    Set Ws = Workspaces(0)
    Set DataBdd = Ws.OpenDatabase(Bdd)
    Set DataXls = Ws.OpenDatabase(Xls, 0, 0, « Excel 8.0; »)    

    ‘DataBdd.Execute « SELECT * into [Excel 8.0;database= » & Xls & « ].Etiquette FROM Etiquette WHERE [Specif 1] = ’11KW/400V' »
     DataBdd.Execute « SELECT * into [Excel 8.0;database= » & Xls & « ].Etiquette FROM Etiquette »
End Sub

Si l’erreur Isam apparaît, c’est qu’il faut dans l’install Office cocher le truc qui va bien dans les données (de mémoire. Faut fouiller pour plus de détail).

Quelques commandes en VBA


(récupérées de: https://codes-sources.commentcamarche.net/faq/484-vba-excel-aide-aux-debutants-quelques-morceaux-de-codes –>Voir les commentaires)

Les différentes méthodes décrites par la suite ne sont évidemment pas les seules possibles, ni même les meilleures, mais elles fonctionnent.    

Sélection d'une feuille

    Sheets(« NomDeLaFeuille »).Select

Sélection d'une cellule

    Range(« A1 »).Select

Ouverture d'un autre fichier Excel

    ChDir « Chemin du répertoire du fichier »    
    Workbooks.Open Filename:=  » Chemin du répertoire du fichier\fichier.xls « 

Fermeture d'un fichier

    ActiveWindow.Close ‘pour fermer le fichier en cours
Ou
    Workbooks.Close Filename:=  » Chemin du répertoire du fichier\fichier.xls « 

Parcourir les lignes d'un fichier

    i = 1    
    Sheets(« Base »).Select    
    While Not Range(« A » & i).Value = «  »    
        i = i + 1    
    Wend

Parcourir les colonnes

    While Cells(1, i) <> «  »    
        i = i + 1    
    Wend

Trouver la lettre associée au chiffre pour la colonne

    NumCol = Cells(1, i).Column   
    lettre = IIf(NumCol > 26, Chr(64 + NumCol \ 26) & Chr(64 + NumCol Mod 26), Chr(64 + NumCol))

Tirer les formules

    Range(« A3:Z3 »).Select ‘sélection de la ligne contenant la formule    
    Selection.AutoFill Destination:=Range(« A3:Z » & i – 1), Type:=xlFillDefault   
    Range(« A3:Z » & i – 1).Select

Adapter un graphique

    ActiveSheet.ChartObjects(« Graphique 3 »).Activate    
    ActiveChart.SeriesCollection(3).Select   
    ActiveChart.SeriesCollection(3).XValues = « =’% Nom classeur?!R4C1:R » & i & « C1 »   
    ActiveChart.SeriesCollection(1).XValues = « =’% Nom classeur?!R4C1:R » & i & « C1 »   
    ActiveChart.SeriesCollection(2).XValues = « =’% Nom classeur?!R4C1:R » & i & « C1 »   
    ActiveChart.SeriesCollection(3).Values = « =’% Nom classeur?!R4C5:R » & i & « C5 »   
    ActiveChart.SeriesCollection(2).Select   
    ActiveChart.SeriesCollection(2).Values = « =’% Nom classeur?!R4C7:R » & i & « C7 »   
    ActiveChart.SeriesCollection(1).Select   
    ActiveChart.SeriesCollection(1).Values = « =’% Nom classeur?!R4C3:R » & i & « C3 »

Adapter la taille des cellules

    ‘redimensionnement des cellules
    Rows(« 2: » & i).Select   
    Selection.RowHeight = 25   
    Range(« A1:H1 »).Select

Changer les bordures

    ‘on s’occupe des bordures du tableau
    Range(« B3:H » & i).Select    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone   
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone   
    With Selection.Borders(xlEdgeLeft)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
        .ColorIndex = xlAutomatic   
    End With   

    With Selection.Borders(xlEdgeTop)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
        .ColorIndex = xlAutomatic   
    End With   

    With Selection.Borders(xlEdgeBottom)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
        .ColorIndex = xlAutomatic   
    End With   

    With Selection.Borders(xlEdgeRight)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
       .ColorIndex = xlAutomatic   
    End With   

    With Selection.Borders(xlInsideVertical)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
        .ColorIndex = xlAutomatic   
    End With   

    With Selection.Borders(xlInsideHorizontal)   
        .LineStyle = xlContinuous   
        .Weight = xlMedium   
        .ColorIndex = xlAutomatic   
    End With

Récupérer une valeur sur une autre feuille

    nb = Range(« B » & i).Value    
    Sheets(« nb rebut »).Select    
    Range(« C » & j).Value = nb

Insérer ou effacer une ligne

    Rows(« 4:4 »).Select    
    Selection.Delete Shift:=xlUp ‘ pour supprimer   
    Rows(« 5:5 »).Select   
    Selection.Insert Shift:=xlDown ‘ pour insérer

Afficher le nom de l'utilisateur tel qu'il apparaitra en tant qu'auteur (Ex: MRD)

    Function TrouveUtilisateur()
        TrouveUtilisateur = Application.UserName
    End Function

Afficher le nom de l'utilisateur de la session Windows (Ex: SESA8675)

    Public Function UserName()
        UserName = Environ$(« UserName »)
    End Function