Excel

Sommaire:

Excel : Astuces et macros...

Mes petites macros toujours utiles en clientèle ;-)

Compter les résultats d'un filtre automatique

Une simple formule pour répondre à cette problématique qu'aurait du inclure Microsoft dans son tableur... Lien trouvé ici : http://www.01net.com/article/250967.html

=SOUS.TOTAL(3;[Range])

Ex.
=SOUS.TOTAL(3;A4:A105)

PS: Penser ne pas inclure la ligne de titre dans le Range... (ou soustraire 1 du total le cas échéant).

Afficher le chemin complet du classeur en cours

ActiveWorkbook.Path & iif(len(ActiveWorkbook.Path)>0,  "\" ,"") & ActiveWorkbook.Name

Afficher les liaisons du classeur en cours

Sub ListLinkSources()
' Cf. http://www.exceltip.com/show_tip/Links_in_VBA/List_all_the_workbook_links_in_a_workbook_using_VBA_in_Microsoft_Excel/356.html

    Dim aLinks As Variant
    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLinks) Then
        ' Sheets.Add
        For i = 1 To UBound(aLinks)
            ' Cells(i, 1).Value = aLinks(i)
            Debug.Print aLinks(i)
        Next i
    End If
End Sub

Lister les feuilles du classeur en cours

Sub ListWorksheets()
    For Each owks In ActiveWorkbook.Worksheets
        Debug.Print owks.Name
    Next
End Sub

Afficher à partir de la cellule en cours des liens vers toutes les feuilles du classeur

Sub PrintSheetsList()
'================================================================================
'
' Affiche la liste des feuilles du classeur en cours...
' ...et applique des liens vers les feuilles
'
'================================================================================

On Error Resume Next

Dim wks     As Worksheet
    
    For Each wks In ActiveWorkbook.Sheets
        If wks.Index > 1 Then
            ' Inscrit le nom de la feuille
            ActiveCell.Value = wks.Name
            
            ' Ajoute un lien vers la cellule A1 de la feuille
            ActiveSheet.Hyperlinks.Add ActiveSheet.Range(ActiveCell.Address), "", "'" & wks.Name & "'!A1", wks.Name & " >>"
            
            ' Ajoute la description de la feuille selon Feuille!A2
            Cells(ActiveCell.Row, ActiveCell.Column + 1).Value = Range("'" & wks.Name & "'!B1").Value
            
            ' Sélectionne la cellule suivante
            Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
        End If
    Next
    

End Sub

Remplacer plusieurs mots dans une feuille

Cette petite macro permet de remplacer plusieurs mots dans la feuille en cours. Les mots sont définis dans le code VBA.

TODO : Permettre de saisir les mots dans excel dans une zone de 2 colonnes

Public aWhat(100)           As String
Public aReplacement(100)    As String
Public iDim                 As Integer


Sub ReplaceInCells()
Dim iLoop       As Integer

    iDim = 0

    AddWord "TYPE_EVENT||TYPE_EVENEMENT"
    AddWord "IMPORT Mig EN||IMPORT B2425 - SIC EN Migrations"
    AddWord "IMPORT Mig GP||IMPORT B2420 - SIC GP Migrations"
    AddWord "IMPORT Resil EN||IMPORT B2422 - SIC EN Résiliations"
    AddWord "IMPORT Activ EN||IMPORT B2421 - SIC EN Activations"
    AddWord "IMPORT Activ GP||IMPORT B2418 - SIC GP Activations"
    AddWord "IMPORT Activ REMUS||IMPORT B2392 - REMUS Activations"
    AddWord "IMPORT Resil GP||IMPORT B2419 - SIC GP Résiliations"
    AddWord "IMPORT Resil REMUS||IMPORT B2393 - REMUS Résiliations"

    For iLoop = 0 To iDim - 1
        Cells.Replace What:=aWhat(iLoop), Replacement:= _
            aReplacement(iLoop), LookAt:=xlPart, SearchOrder:=xlByRows, _
            MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    Next
        
    MsgBox "Opération terminée !"
    
End Sub

Sub AddWord(pString As String)

Dim aTemp()     As String

    aTemp = Split(pString, "||")
    aWhat(iDim) = aTemp(0)
    aReplacement(iDim) = aTemp(1)
    
    iDim = iDim + 1

End Sub