Classeurs Excel

Vous trouverez dans cette rubrique des exemples de programmes se rapportant aux classeurs.

Indicer un nom de classeur lors de l'enregistrement.
Ajouter des feuilles dans un classeur et les renommer.
Enregistrer une copie du classeur (sans modifier le classeur ouvert).
Fermer tous les classeurs ouverts sauf le classeur actif.
Renommer les onglets d'un classeur (Ex. Mois1, Mois2, Mois3, etc...).
Trier les onglets d'un classeur.

Indicer un nom de classeur lors de l'enregistrement

Je dois tous les jours, voire 2 ou 3 fois
download film. board games. online casinos. casino games. online casinos. online casinos
par jour générer (en auto) un fichier Excel.
Pour éviter d'écraser l'ancien et avoir un historique, j'ai complété le nom de mon fichier
avec la date du jour et un N° d'indice.
Exemple :
      Synthèse carnet du 25-05-06-V0.xls
      Synthèse carnet du 25-05-06-V1.xls
      Synthèse carnet du 26-05-06-V0.xls
      Synthèse carnet du 27-05-06-V0.xls
Exemple :
      ...etc

Public Chemin As String

Public NoIndice As Integer

Sub Programme()

    Mydate = Format ( Now (), "dd-mm-yy" )

    Chemin = ActiveWorkbook.Path

    Workbooks.Add

    ActiveCell.FormulaR1C1 = "Voici une exemple"

    Range( "A1" ).Select

    ' Recherche du N° d'indice

    RechercheFichiersPourIndice

    ActiveWorkbook.SaveAs Filename:= _

            Chemin & "\Synthèse carnet du " & Mydate & "-V" & NoIndice & ".xls" , _

            FileFormat:=xlNormal, Password:= "" , WriteResPassword:= "" , _

            ReadOnlyRecommended:= False , CreateBackup:= False

End Sub

Sub RechercheFichiersPourIndice()

    Dim Shortfilename As String

    Mydate = Format ( Now (), "dd-mm-yy" )

    Shortfilename = "Synthèse carnet du " & Mydate & ".xls"

    NameSansextension = Mid (Shortfilename, 1 , Len (Shortfilename) - 4 )

    With Application.FileSearch

        .Filename = NameSansextension

        .FileType = msoFileTypeExcelWorkbooks

        .LookIn = Chemin

        .SearchSubFolders = True

        .Execute

        With .FoundFiles

            If .Count = 0 Then

            Else

                NoIndice = .Count

            End If

        End With

    End With

End Sub

Function Shortfilename(LongFilename As String ) As String

    For i = Len (LongFilename) To 1 Step - 1

        If Mid (LongFilename, i, 1 ) = "\" Then Exit For

    Next

    Shortfilename = Mid (LongFilename, i + 1 , Len (LongFilename))

    NameSansextension = Mid (Shortfilename, 1 , Len (Shortfilename) - 4 )

End Function

Ajouter des feuilles dans un classeur et les renommer

Sub AjouterRenommerFeuilles()
Dim cpt As Integer
cpt = 1
      Do While cpt < 4 ' Ajoute 3 feuilles
' Ajout d'une feuille
         Application.Sheets.Add After:=Sheets.Item(Sheets.Count), Type:=xlWorksheet
' Renomme la feuille
         Application.ActiveSheet.Name = "Semaine " & CStr(cpt)
         cpt = cpt + 1
      Loop
End Sub

Enregistrer une copie du classeur

Sub SaveCopyAs()
ActiveWorkbook.SaveCopyAs "C:\excel\MonDouble.xls"
End Sub

Fermer tous les classeurs ouverts (sauf le classeur actif)

Sub FermeClasseurs()
      For Each Wk In Workbooks
         If Wk.Name <> ThisWorkbook.Name Then
         Wk.Close savechanges:=True
         End If
      Next Wk
End Sub

Renommer les onglets d'un classeur

Sub RenommeOnglets()
' Renomme les onglets CL1, CL2, CL3, etc ...
Dim I As Integer
Application.ScreenUpdating = False
      For I = 1 To 3
         Worksheets(I).Name = "CL" & I
      Next I
End Sub

Trier les onglets d'un classeur

Sub TriNomsOnglets()
Dim I As Integer, J As Integer
For I = 1 To Sheets.Count
      For J = 1 To I - 1
            If UCase(Sheets(I).Name) < UCase(Sheets(J).Name) Then
            Sheets(I).Move Before:=Sheets(J)
      Exit For
            End If
      Next J
Next I
End Sub