Bonjour,
voici ma macro, elle me permet d'enregistrer et d'incrémenter un fichier.
elle marchait trés bien sous excel 2003, maintenant je suis sous 2010, et j'ai un msg de problème de compabilité qui s'affiche.
voici ma macro :
Sub EnregFicheTrans()
Dim Chemin As String, Fichier As String, MyFile As String
Dim Index As Integer
Dim Fname
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Graphique").Copy 'sélectionne la feuille fiche de transport
With ActiveSheet
.Range("A1:AK90").Value = .Range("A1:AK90").Value 'sélectionne la zone de la fiche dans le nouveau classeur
.Shapes(.Shapes.Count).Delete
End With
Chemin = "U:\PUBLIC\COMMUN\ORGANISATION_METHODES\24 - Stages et apprentissage\Loïc\Excel" 'Chemin sauvegarde
Do
Fichier = "One page videocodage 2013 mois n°" & Index + 1 & ".xls"
MyFile = Dir(Chemin & Fichier) 'existe t il déja?
If MyFile <> "" Then Index = Index + 1 'si oui, incrémenter index
Loop Until MyFile = ""
Do
ChDir Chemin
Fname = Application.GetSaveAsFilename(Fichier, "Excel Files (*.xls), *.xls") 'ouvre boite de dialogue enregistrement
Loop Until Fname <> False
ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlNormal ' enregistre nouveau fichier
ActiveWorkbook.Close
End Sub
je pense que le souci se situe au niveau de la partie en rouge, mais quand je remplace .xls par .xlsx ça ne marche pas..
merci par avance de l'aide
voici ma macro, elle me permet d'enregistrer et d'incrémenter un fichier.
elle marchait trés bien sous excel 2003, maintenant je suis sous 2010, et j'ai un msg de problème de compabilité qui s'affiche.
voici ma macro :
Sub EnregFicheTrans()
Dim Chemin As String, Fichier As String, MyFile As String
Dim Index As Integer
Dim Fname
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Graphique").Copy 'sélectionne la feuille fiche de transport
With ActiveSheet
.Range("A1:AK90").Value = .Range("A1:AK90").Value 'sélectionne la zone de la fiche dans le nouveau classeur
.Shapes(.Shapes.Count).Delete
End With
Chemin = "U:\PUBLIC\COMMUN\ORGANISATION_METHODES\24 - Stages et apprentissage\Loïc\Excel" 'Chemin sauvegarde
Do
Fichier = "One page videocodage 2013 mois n°" & Index + 1 & ".xls"
MyFile = Dir(Chemin & Fichier) 'existe t il déja?
If MyFile <> "" Then Index = Index + 1 'si oui, incrémenter index
Loop Until MyFile = ""
Do
ChDir Chemin
Fname = Application.GetSaveAsFilename(Fichier, "Excel Files (*.xls), *.xls") 'ouvre boite de dialogue enregistrement
Loop Until Fname <> False
ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=xlNormal ' enregistre nouveau fichier
ActiveWorkbook.Close
End Sub
je pense que le souci se situe au niveau de la partie en rouge, mais quand je remplace .xls par .xlsx ça ne marche pas..
merci par avance de l'aide