Différence de format de fichier.

Neonours

XLDnaute Nouveau
Bonjour le forum,

Tout d'abords, je tiens à remercier chaleureusement @Pierrot 93 , @Hulk , @tototiti2008 , @gilbert_RGI , @Orodreth et @Modeste geedee de l'aide qu'ils m'ont apporté à la réalisation de ce code ainsi que des explications et conseils qui m'ont permis d'en apprendre plus sur le VBA.

Vous trouverez, en pièce jointe, mon code qui me pose un dernier léger souci.

Le fichier créer par le biais de ce code est juste (visuellement et les formule également) mais lorsque je veux le rouvrir, il me dit que "Le format du fichier que je tente d'ouvrir est différent de celui spécifié par l'extension.

Auriez-vous une idée pour régler celà?

Accessoirement, si l'envie vous prend de nettoyer mon code probablement très, très (très?) brouillon, je serais ravi d'en apprendre encore un peu :D

Pour celles et ceux qui ne peuvent pas ouvrir le fichier joint, voici le code:
Code:
Sub Bouton1_Cliquer()

'Déclaration des variable.
Dim annee As Variant, Doss As String, Fic As String, a As Variant, Sh As Worksheet, t() As Variant

Doss = Dir("C:\DONNEES A\DONNEES B\HORAIRES\VEILLES " & annee, vbDirectory)
Fic = Dir("C:\DONNEES A\DONNEES B\HORAIRES\VEILLES " & annee & "\" & "Veilles " & annee & ".xls", vbNormal)

'Boîte pour l'entrée de l'année.
Do
    If Not IsEmpty(annee) Then MsgBox "Cette entrée n'est pas valide!" & Chr(10) & "Merci d'entrer une année en 4 chiffres.", 0 + 48, "Entrée invalide"
    annee = Application.InputBox("Insérer une année en 4 chiffres", "Année", Type:=1)
    If VarType(annee) = vbBoolean Then Exit Sub
Loop While annee < 1000 Or annee > 9999

'Vérification de l'existence du dossier et du fichier. Création de ces composants si inexistant.
If Doss <> "" And Fic <> "" Then
        MsgBox "Le classeur demandé existe déjà!"
    ElseIf Doss <> "" And Fic = "" Then
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:="C:\DONNEES A\DONNEES B\HORAIRES\Veilles " & annee & "\" & "Veilles " & annee & ".xls"
    Else
        MkDir "C:\DONNEES A\DONNEES B\HORAIRES\VEILLES " & annee
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:="C:\DONNEES A\DONNEES B\HORAIRES\Veilles " & annee & "\" & "Veilles " & annee & ".xls"
End If

'Copie des onglets
    cl1 = ThisWorkbook.Name
    cl2 = ActiveWorkbook.Name
For Each Sh In Workbooks(cl1).Worksheets
    Workbooks(cl1).Sheets(Sh.Name).Copy Before:=Workbooks(cl2).Sheets(1)
Next Sh

'Suppression des onglets inutiles
    t = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
    Application.DisplayAlerts = False
For Each ws In Worksheets
    If IsError(Application.Match(ws.Name, t, 0)) Then ws.Delete
Next ws
    Application.DisplayAlerts = True

'Changement de la date en cellule C4
With ActiveWorkbook.Worksheets("Janvier")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 1, 1)
End With

'+Vérification si l'année est bisextile et sinon, supprimer la colonne AE
With ActiveWorkbook.Worksheets("Février")
        .Activate
        ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 2, 1)
    If ActiveSheet.Range("AE4").Value = DateSerial(CInt(annee), 3, 1) Then
        Columns("AE:AE").Delete Shift:=xlToLeft
    End If
End With

With ActiveWorkbook.Worksheets("Mars")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 3, 1)
End With

With ActiveWorkbook.Worksheets("Avril")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 4, 1)
End With

With ActiveWorkbook.Worksheets("Mai")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 5, 1)
End With

With ActiveWorkbook.Worksheets("Juin")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 6, 1)
End With

With ActiveWorkbook.Worksheets("Juillet")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 7, 1)
End With

With ActiveWorkbook.Worksheets("Août")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 8, 1)
End With

With ActiveWorkbook.Worksheets("Septembre")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 9, 1)
End With

With ActiveWorkbook.Worksheets("Octobre")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 10, 1)
End With

With ActiveWorkbook.Worksheets("Novembre")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 11, 1)
End With

With ActiveWorkbook.Worksheets("Décembre")
    .Activate
    ActiveSheet.Range("C4").Value = DateSerial(CInt(annee), 12, 1)
End With
    
    ActiveWorkbook.Save

End Sub

Encore merci à ces personnes et merci d'avance à celles et ceux qui se pencheront sur mon souci.

Neonours
 

Pièces jointes

  • Pour exemple_1.xlsm
    55 KB · Affichages: 23
C

Compte Supprimé 979

Guest
Re : Différence de format de fichier.

Bonjour

Code:
 ActiveWorkbook.SaveAs Filename:="C:\DONNEES A\DONNEES B\HORAIRES\Veilles " & annee & "\" & "Veilles " & annee & ".xls"
".xlsx" à la fin pour Excel 2010

Bonne journée ;)
 
C

Compte Supprimé 979

Guest
Re : Différence de format de fichier.

Bonsoir

Pourquoi tu n'utilises pas l'enregistreur de macro !??

Code:
ActiveWorkbook.SaveAs Filename:="D:\Classeur1.xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

A+
 

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 182
dernier inscrit
moutassim.amine