L'informatique à votre portée
L'informatique prêt-à-porter

Faites appel à moi pour vos formations
sur les dpts 81, 31, 82, 11 et 67 (Strasbourg)
Confiez moi vos développements Office

FacebookTwitterGoogle BookmarksLinkedin

Créer une feuille sommaire

Imprimer E-mail
5 mars 2014
Sub CreationFlleSommaire()
     Dim iNb As Integer, iNoL As Integer
     Dim bExisteFlle As Boolean

On Error Resume Next
     bExisteFlle = Worksheets("Sommaire").Name
     If Err.Number = 9 Then ' il y erreur si la feuille n'existe pas
Err.Clear
          ActiveWorkbook.Worksheets.Add before:=Sheets(1) ' dans ce cas on ajoute une feuille
ActiveSheet.Name = "Sommaire" 'on la nomme Sommaire
End If
On Error GoTo 0
     With Worksheets("Sommaire") 'avec cette feuille Sommaire
iNoL = 1
          .Cells.Clear 'on supprime tout ce qu'elle contient (au cas où elle existait auparavent)
For iNb = 1 To Worksheets.Count 'pour chaque feuille du classeur
If Worksheets(iNb).Name <> "Sommaire" Then 'si elle est différente du sommaire
'ajout d'un lien hypertexte vers la cellule A1 de la feuille sur la feuille Sommaire
.Hyperlinks.Add Anchor:=.Range("A" & iNoL), Address:="", SubAddress:="'" & Worksheets(iNb).Name & "'!A1"
                    .Range("A" & iNoL).Value = Worksheets(iNb).Name
                    iNoL = iNoL + 1
               End If
          Next
     End With
End Sub

Créer un classeur contenant une feuille par mois

Imprimer E-mail
5 mars 2014
Sub CreerClassMois(strAn As String)
     Dim wkb As Workbook, Flle As Worksheet
     Dim iNo As Integer

Set wkb = Workbooks.Add
On Error Resume Next
     For Each Flle In wkb.Worksheets
          Flle.Delete
     Next
     ' dateserial renvoit une date à partir d'une année, du chiffre correspondant au mois et au jour
     ' format permet de renvoyer cette date en ne retenant que le mois en lettre et l'année
     ' la fonction proper permet de mettre la 1ère lettre en majuscule
Worksheets(1).Name = Application.WorksheetFunction.Proper(Format(DateSerial(strAn, 1, 1), "mmmm yyyy"))
On Error GoTo 0
     For iNo = 2 To 12
          Set Flle = wkb.Worksheets.Add(after:=Worksheets(iNo - 1))
          Flle.Name = Application.WorksheetFunction.Proper(Format(DateSerial(strAn, iNo, 1), "mmmm yyyy"))
     Next
End Sub

Ouvrir un classeur seulement s'il n'est pas déjà ouvert

Imprimer E-mail
5 mars 2014
Function OuvreClasseur(strChem As String) As Workbook
Dim strName As String
     ' s'il y a erreur on passe à la ligne suivante
On Error Resume Next
strName = Dir$(strChem) 'lorsque le fichier existe, cette fonction renvoie le nom seul du fichier
Workbooks(strName).Activate
' si le classeur n'est pas ouvert cela provoque une erreur
If Err <> 0 Then
Err.Clear 'on remet à 0 les erreurs
Workbooks.Open strChem 'on ouvre alors le fichier
End If
Set OuvreClasseur = Workbooks(strName) ' on renvoie le classeur
End Function

Trier les feuilles

Imprimer E-mail
5 mars 2014

Sub TriFeuille()
    Dim byNbFlle As Byte, byN As Byte
    Dim flleNouv As Worksheet
    
On Error GoTo GestionErreur
    'ne raffraichit pas l'affichage
    Application.ScreenUpdating = False
    'ajoute une nouvelle feuille et l'attribue à la variable flleNouv
    Set flleNouv = ActiveWorkbook.Worksheets.Add
    'compte le nombre de feuilles
    byNbFlle = ActiveWorkbook.Sheets.Count
    'dans la nouvelle feuille
    With flleNouv
        ' de 1 au nb de feuille
        For byN = 1 To byNbFlle
            'si le nom de la feuille n'est pas celui de la nouvelle
            ' inscription dans A-Nofeuille du nom de la feuille "Nofeuille"
            If ActiveWorkbook.Sheets(byN).Name <> flleNouv.Name Then _
                .Range("A" & byN) = ActiveWorkbook.Sheets(byN).Name
        Next