Rapport de message :*
 

Re: Test login et traitement

Titre du sujet : Re: Test login et traitement
par vg00 le 04/01/2012 14:51:39

Bonjour, je cherche toujours à optimiser ce code contenu dans cotation.xlt
1) l'adresse mail est toujours identique suivant les 4 cas de log
2) la récupération du log machine n'est pas terribles j'ai du aller modifier l'utilisateur déclaré d'excel 2007 d'un collègue
3) l'effacement total des macros n'est pas pleeinement efficace il reste du code et à l'ouverture du fichier sauvegardé j'ai quand même la question voulez vous activer les macros alors que voudrais que le fichier n'en comporte plus !
4) à l'ouverture je souhaiterais utiliser un mini formulaire demandant la saisie
Société :
Contact :
Téléphone :
Portable :
Fax :
Mail :
5) compléter les 2 onglets offre et offre PV voir un suivant Offre AC qui viendra
à la manière la macro ci dessous mais je n'ai pas réussi à bien modifier
If Nom <> "" Then
        With Sheets(1)
            .Cells(10, 3).Value = Nom
            .Cells(11, 3).Value = Tel
            .Cells(12, 3).Value = Fax
            .Cells(13, 3).Value = Mail
            .Cells(7, 10).Value = Initiales
6) après sauvegarde et juste avant fermeture fichier ou impression
Remplissage de 2 onglets (structure identique de l'entête)pour l'instant d'autres éventuels à venir
1er onglet : Offre
2ème onglet : Offre PV

Société en M15
Contact en K10
L11 = concaténer(téléphone / portable)
Fax : L12
Mail : K13

7) et cerise sur le gâteau serait d'aller compléter le fichier cotation2012.xls
comme suit définition de la ligne à remplir
2012-0001 doit écrire en ligne x donc x=0001+1 et ainsi de suite
-en Dx venir mettre la date de création du fichier qui doit être figer par la macro afin que lorsque l'on ouvre après sauvegarde la date ne change plus
- en Fx : Société
- en Gx : Contact
- en Ix : les deux dernières lettre de la variable initiales

si le fichier cotation2012.xls est ouvert renvoyer un message voyez avec (utilisateur du fichier) pour qu'il vous laisse l'accès et réessayer
si la ligne ou l'on souhaite écrire n'est pas vide ? je ne sais pas il vaut mieux passer une ligne mais ???

8) on peut aussi définir le lieux de sauvegarde du fichier qui est le répertoire réseau d'ouverture du xlt

9) la sauvegarde pourrait elle aussi être inteligente obligatoire en xls pas de xlsx...
et le 2012-000x fixé par test de présence de fichier dans répertoire et test de dernier remplissage dans le fichier cotation2012...

10) remplacer le 2011 de la macro par une variable de l'année en cours


Si quelqu'un est interessé on pourras essayer de scinder les différents axes pour faire évoluer cela

----


Option Explicit
Function login() As String
    login = Application.UserName
End Function

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim StartLine As Long, LineCount As Long

'Tu insères ton code ici que tu veux exécuter à l'ouverture

'd'un nouveau classeur basé sur le modèle.

 

'Ce qui suit efface toute la procédure événementielle "Workbook_Open"
On Error Resume Next
If ThisWorkbook.Path = "" Then
    If ThisWorkbook.VBProject.Protection Then Exit Sub
    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        StartLine = .ProcStartLine("Workbook_Open", 0)
        If StartLine Then
            LineCount = .ProcCountLines("Workbook_Open", 0)
            .DeleteLines StartLine, LineCount
        End If
    End With
End If
End Sub


Private Sub Workbook_Open()
' DateduJour Macro '
Sheets("Offre").Range("B7").Value = Date
Dim Nom As String, Tel As String, Fax As String, Mail As String, Initiales As String
    Select Case login
    Case "xxxxxxxx"
        Nom = "xxxxxxxx"
        Tel = "Tél : xxxxxxxx"
        Fax = "Fax : xxxxxxxx"
        Mail = "a.a@a.a"
        Initiales = "2011-0000C/xx"
    Case "yyyyyyyy"
        Nom = "yyyyyyyy"
        Tel = "Tél : yyyyyyyy"
        Fax = "Fax : yyyyyyyy"
        Mail = "a.a@a.a"
        Initiales = "2011-0000C/yy"
    Case "zzzzzzz"
        Nom = "zzzzzzz"
        Tel = "Tél : zzzzzzz"
        Fax = "Fax :zzzzzzz"
        Mail = "a.a@a.a"
        Initiales = "2011-0000C/zz"
    Case "wwwwwww"
        Nom = "wwwwwww"
        Tel = "Tél : wwwwwww"
        Fax = "Fax : wwwwwww"
        Mail = "a.a@a.a"
        Initiales = "2011-0000C/ww"
    Case Else
        MsgBox "Login non répertorié"
    End Select

    If Nom <> "" Then
        With Sheets(1)
            .Cells(10, 3).Value = Nom
            .Cells(11, 3).Value = Tel
            .Cells(12, 3).Value = Fax
            .Cells(13, 3).Value = Mail
            .Cells(7, 10).Value = Initiales
        End With
    End If
End Sub