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 |
Forums