insertion d'un numéro automatique

titooooo

XLDnaute Occasionnel
Bonjour ,

je voudrais bien réaliser 2 truc

ouvrir un fichier Excel et dés son ouverture il demande quel fichier faudra ouvrir ( via une fenêtre vba)

fichier 1 , 2 ,3 ,,,,,,,, qui se trouvent dans un même emplacement

une fois le choix fait le fichier s'ouvre

2éme étape a 'l'ouverture fichier et si je fait imprimer je voudrais avoir ceci:

a-insertion d'un numéro automatique ( pour besoin de suivi) genre concactener (activité ,date,heure en seconde)

b- lors de impression je voudrais dans l’entête ou ailleurs que j'aurais une cellule avec ce numéro automatique et une autre avec le nom d'utilisateur excel ( en d'autre terme le login session de la personne qui a lancé l’impression)
 

camarchepas

XLDnaute Barbatruc
Re : insertion d'un numéro automatique

Bonjour,

A mettre dans un module standard

Code:
Sub lance()
Dim Fichier As String, Chemin As String, Informations As String
Dim LigneFin As Long

Chemin = "c:\temp\"
ChDir Chemin
Fichier = Application.GetOpenFilename("Fichier Excel (*.xls; *.xlsx; *.xlsm ), *.xls*")
If Fichier <> "Faux" Then
    
    'Pour création de l'onglet s'il n'existe pas
    On Error Resume Next
     Sheets("Numéros").Select
     If Err.Number <> "" Then
       ThisWorkbook.Worksheets.Add
       ActiveSheet.Name = "Numéros"
       With Sheets("Numéros")
        .Range("A1") = "Numéro"
        .Range("B1") = "Fichier"
        .Range("C1") = "Nom utilisateur"
        .Range("D1") = "Horodatage"
       End With
     End If
       
    'initialise numéro et l'insert mais ou
    With Sheets("Numéros")
       LigneFin = .Range("A" & Rows.Count).End(xlUp).Row
       If .Range("A" & LigneFin) = "Numéro" Then
         .Range("A" & LigneFin + 1).Value = CLng("1")
        Else
         .Range("A" & LigneFin + 1).Value = CLng(.Range("A" & LigneFin)) + 1
       End If
      .Range("B" & LigneFin + 1) = Fichier
      .Range("C" & LigneFin + 1) = Application.UserName
      .Range("D" & LigneFin + 1) = Now
       Informations = .Range("A" & LigneFin + 1) & " " & Fichier & " " & Application.UserName & " " & .Range("D" & LigneFin + 1)
    End With
    Workbooks.Open Filename:=Fichier
    ActiveSheet.PageSetup.LeftHeader = Informations
End If

End Sub
 

Discussions similaires

Réponses
8
Affichages
708
V
Réponses
2
Affichages
970
VBA DEAD
V

Statistiques des forums

Discussions
312 836
Messages
2 092 638
Membres
105 475
dernier inscrit
ramzi slama