Problème macro VBA

[sakura]

Bonjour,

J'ai un problème pour créer une macro sous VBA, je suis encore novice sur le sujet.

Je vous explique mon problème en espérant bien me faire comprendre.

Sur ma macro initiale, lorsque je clique sur un bouton, elle déclenche une copie du fichier actuel dans un dossier spécifique en reprenant le numéro qui se situe en A1 histoire de faire un chrono des fichiers.
C'est un fichier modèle qui n'est jamais modifié, donc à chaque ouverture il est vide sauf en A1 ou se trouve un numéro.
Ma question : est-il possible de créer une macro pour qu'il puisse à chaque ouverture aller vérifier dans le dossier spécifique et prendre le dernier fichier enregistrer, récupérer le numéro et faire +1 ?

Merci pour vos réponses qui j'espère vont m'aider !
++

 

[skoobi]

Re : Problème macro VBA

Bonjour sakura,

oui c'est possible mais pour t'aider il nous faut un exemple concret.

 

[sakura]

Re : Problème macro VBA

Merci Skoobi,

Je joint mon fichier excel si ça peut aider.
J'avais fait une autre macro mais ça ne vas pas car le fichier initial est modifié, et je suis perdu entre ce que je dois modifier ou enlever...

Merci encore de votre aide et je suis là pour toute question.
++

 

[skoobi]

Re : Problème macro VBA

Re,

la partie que j'ai ajouté en bleu (remplace tout le code dans ton fichier) va récupéré le dernier numéro dans le dossier indiqué pour l'écrire en B1:

Sub new_credit_note()
[B][COLOR=blue]Dim RefAnc As String, RefActuel As String[/COLOR][/B]
'Macro créée par LABIT
'************ NOUVEAU 09 MARS 2009 - à rajouter ************
'Informer le fichier que le numéro a changé
    Range("logique").Value = "oui"
'************ Fin nouveauté ***************
[COLOR=blue][B]'on cherche la dernière référence enregistrée
RefActuel = Left(Dir("C:\Demande avoir\"), 11)
Do
  If RefActuel > RefAnc Then RefAnc = RefActuel
  RefActuel = Left(Dir(), 11)
Loop Until RefActuel = ""[/B][/COLOR]
[COLOR=blue][B]    Range("B1").Value = RefAnc
    Range("I1").Value = Range("B1").Value
[/B][/COLOR]    Range("I1").Select
    ActiveCell.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 'Enlever les espaces en trop
    Application.CutCopyMode = False
   Range("I1").Value = Range("I1").Value + 1 'Ancien N° d'avoir + 1
   alpha = Range("I1").Value
   'Retenir les 6 chiffres qui composent le nouveau n° d'avoir
   beta = Mid(alpha, 1, 1)
   gamma = Mid(alpha, 2, 1)
   Delta = Mid(alpha, 3, 1)
   epsilon = Mid(alpha, 4, 1)
   zeta = Mid(alpha, 5, 1)
   eta = Mid(alpha, 6, 1)
   'Reconstituer un n° d'avoir avec les espaces
   theta = beta & " " & gamma & " " & Delta & " " & epsilon & " " & zeta & " " & eta
   Range("I1").ClearContents 'Effacer en I1
   Range("B1").Value = theta 'Insérer le nouveau n° d'avoir
'Enregistrer dans un répertoire par numéro
ChDir "C:\Demande avoir"
ActiveWorkbook.SaveAs Filename:= _
    "C:\Demande avoir\" & theta & Range("B6") & ".xlsm.xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
'Définir la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$33"
'Imposer de sortir l'avoir sur 1 page (max 1 de large et max 1 de haut)
With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
End With
'Ouvrir Aperçu avant impression
ActiveWindow.SelectedSheets.PrintPreview
End Sub

Bon test.

 

[sakura]

Re : Problème macro VBA

MERCI !!!!

C'est super ça fonctionne, merci beaucoup

A bientôt ++