Mission du 06/2019 au 06/2023 sous la responsabilité du directeur des études informatiques, Benoit CLAUSSE et sa remplaçante, Corinne DAJON et avec l’appui du directeur des systèmes d’information, Philippe MERVILLE.
Programme : Commercialisation d’une offre à 130.000 entreprises baptisé SHIELD, avec pour élément essentiel, l’industrialisation du processus d’adhésion
Fourniture à l’ensemble des forces de ventes internes ou externes, de la capacité de proposer les offres par voie postale et par voie dématérialisée.
Réalisation d’une interface prospect sur le site institutionnel pour leur permettre de générer leur devis en selfcare suite à des campagnes marketing.
Integration d’un mécanisme d’upload des pièces justificatives, de validation de leur conformité et de signature électronique du devis.
Automatisation complète du processus d’adhésion sur base des devis signés et de leurs pièces justificatives conformes chargées (avec circuit de gestion des incomplets).
Enjeux & KPI: la mise en oeuvre de cette brique essentielle dans la stratégie de conquête du groupe Agrica sur un segment de marché élargi s’est faite dans le cadre de la commercialisation d’une offre à grand échelle. D’autre part, le respect du planning de mise à disposition de cette brique pour les commerciaux, imposée par la date de lancement sur laquelle le groupe s’était engagé, était vitalpour la crédibilité du groupe à s’imposer comme un partenaire social de confiance.
Durée de mise en place : 2 ansCout programme ≈ 2 M€
DSI délégataire: Directeur de projet, cellule métier et cellule web
Equipes métier: Pilotages des projets métiers & recettes réalisée par des équipes interne multidisciplinaire.
Rôle : En tant que responsable de ce programme IT, j’ai œuvré à la coordination des intérêts et priorités des équipe impliquées, pour assurer un avancement efficace et cohérent du programme. Il était indispensable que je garantisse les délais de mise à disposition des outils d’aide à la vente pour les deux cibles de commercialisation tout en maintenant la trajectoire d’évolution et d’industrialisation de ces outils.
LES VARIABLES Syntaxe : Dim ExempleVariable as string
Portée des variables projet : Public Dim VarAPortéeGlobale as string module : Private Dim VarAPortéeModule as string fonction/procédure : Dim VarAPortéeLocale as string
LES TYPES Définition d’un nouveau Type :
Type Texemple
Sheet As Sheets
Cat As String
Cell As Range
End Type
Utilisation du Type Texemple
Dim Exemple as Texemple '(Exemple.Sheet, Exemple.Cat, Exemple.Cell)
LES CHAINES DE CARACTERES
Transfo ASCII en caractères : Chr(34) Transfo Caractère en code ASCII : Asc(« A ») String(20,x) = xxxxxxxxxxxxxxxxxxxx space(20) = Len(« toto ») = 4 InStr(« toto », »o ») = 2 Lcase(« TOTO ») = toto UCase(« toto ») = TOTO Left(« Fabrice »,3) = « fab » Right(« Fabrice »,3) = « ice » mid(« Fabrice »,5,2) = « ic »
monTab = split("c/de/fgt","/") (montab(0) = "c" , montab(1) = "de" , montab(2) = "fgt" )
Supprimer les espaces des extremitées d'une chaine de caractères : **Trim**(" toto ") = "toto"
Supprimer les espaces de l'extremitées droite d'une chaine de caractères : **RTrim**(" toto ") = " toto"
Supprimer les espaces de l'extremitées gauche d'une chaine de caractères : **LTrim**(" toto ") = "toto "
remplacer les virgules par des points : strNew = Replace(strOld,",",".")
![Picture](http://nicosurfgadgets.weebly.com/uploads/3/3/9/9/3399316/5476495.png?697)
**LES ROUTINES**
Les routines du VBS sont de deux types : les fonctions qui sont des suites d'instructions retournant une valeur et les procédures qui sont elles aussi des suite d'instructions mais qui ne retournent pas de valeur.
**Portées des routines:**
Public:elle sera accessible à toutes les autres routines dans tous les autres modules de tous les projets actifs (défaut).
Private : si elle sera seulement accessible à d'autres procédures dans le même module.
Static : Les valeurs des variables déclarées dans cette Function sont préservées entre les appels VBA d'Excel.
**Les procédures**
Le test de présence d'une variable lors d'un appel à une procedure se fait avec l'instruction IsMissing
```VBS
Sub ExempleProcédureInit(arg1 as integer ,arg2 as string, optional arg3 as string)
if ismissing(arg3) then action1 else action2
End Sub
Les fonctions
Function exemple_de_fontion(arg1 as integer ,arg2 as string) as boolean
echo "coucou"
End Function Public
Boucles for | for x = 10 to 0 Step -1 action Next
Boucles for each | for each cellule in selected_range action Next
Boucles DO | x = 0 Do action loop Until test
Boucles While | x = 0 While test action Wend
LES FORMATS & DATES
Format(Date, "yy/mmmm/dd")
n ieme jour de l'année = Format(Date, "y")
Now , time, date
Nombre de millisecondes écoulées depuis le démarrage du système : **GetTickCount**
nb de secondes depuis minuit = timmer
Année = year(date)
n° du Mois = month(date)
nom du Mois = monthname(date)
Jour = day(date)
Heure = heure(time)
Heure sur 2 chiffres= Cstr(right("0"& heure(time),2))
Minute = minute(time)
Seconde = seconde(time)
num de série de la date du jour = aujourdhui()
num de série de la date et de l'heure = maintenant()
num de série du dern jr du mois = FIN.MOIS(Date\_départ;Mois)
nb de jrs ouvrés entre 2 dates = NB.JOURS.OUVRES(Date1;Date1;liste\_Jours\_fériés)
jour de la semaine (de 1 à 7) = JOURSEM(Numéro\_de\_série;Type\_retour)
Nombre de jours dans le mois = JOUR(DATE(ANNEE(D);MOIS(D)+1;0))
Exemple 1 | if test1 then : action1 : Elseif test2 : action2 : Else : action3 : End if
Exemple 2 | If test1 Then : action1 Else action2
Exemple 3 | If test1 Then {action1, action2}
Exemple 4 | Valeur = IIF(test;Valeur1;Valeur2)
SELECT CASE
Select case valeur
case valeur1: action1
case valeur2: action2
End select
LES COLLECTIONS
initialiser le catalogue : Dim oCatalogue : Set oCatalogue = CreateObject("Scripting.Dictionary")
Ajouter un élément : _oCatalogue.add
LES OBJETS
Set objExcel = CreateObject("Excel.Application")
Sheets("nom\_de\_la\_feuille").Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
For Each feuille In Worksheets --- --- Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Sheet & "A1", TextToDisplay:=""
Sheets("#1").Unprotect
Sheets("#1").Copy After:=Sheets(Sheets.Count)
newsheetname = "#" & Sheets.Count - 2
Sheets("#1 (2)").name = newsheetname
Gras : cells(x,y).Font.bold = True
Italic : cells(x,y).Font.italic = True
Nom de la police : cells(x,y).Font.name = Arial
Taille de la police : cells(x,y).Font.size = 12
Underline : cells(x,y).Font.underline = True
Style_de_ligne = cells(x,y).Borders(bordure).LineStyle { xlNone – xlContinuous } Taille_bordure = cells(x,y).Borders(bordure).Weight { xlThin – xlMedium – xlThick} Couleur_des_bordures = cells(x,y).Borders.ColorIndex Couleur_de_bordure = cells(x,y).Borders(bordure).ColorIndex { xlInsideVertical – xlEdgeTop – xlEdgeBottom – xlEdgeLeft – xlEdgeRight – xlDiagonalDown – xlDiagonalUp } Valeur_de_la_cellule = cells(x,y).value Cellule_avant_chgt_de_cellule = Target Numéro_de_ligne = Cells(x,y).row Numéro_de_colonne = Cells(x,y).column Supprimer la ligne de la case D3 : range(« D3 »).Delete Shift:=xlUp ou range(« D3 »).EntireRow.Delete Ajouter une ligne : Rows(« 10:10 »).Insert Shift:=xlDown Rechercher un cellule : Set FoundCell = range(« D3:D7 »).Find(valtoseek, LookIn:=xlValues) : FoundLine = IIf (Cellule Is Nothing,0, FoundCell.row) Fixer la taille de la ligne : Rows(« 10:10 »).RowHeight = 12.75 Selection.UnMerge Set exemple_objet_cellule = Cells(x,y).offset(x,y) Set sheet1 = Sheets(« Feuille n°1 ») Set sheet2 = Sheets(2)
Effacer le contenu des cellules : [A1:A10].ClearContents Sélectionner plusieurs lignes : sheet.Rows(« 25:43,52:58 »).Select Sélectionner plusieurs colonnes : sheet.Columns(« A:B », »D:H »).Select Première ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows(1) Dernière ligne de [A1:A10] : [A1:A10].CurrentRegion.Rows([A1:A10].CurrentRegion.Rows.Count) Cellules vides de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeBlanks) Cellules num de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeConstants, 1) { 1:num – 2:str – 3:str ou num } Cells commentées de [A1:A10] : [A1:A10].SpecialCells(xlCellTypeComments) Cellule non vide la plus à droite de [A1:A10] : [A1:A10].End(xlToRight) { xlDown – xlToRight – xlToLeft – xlUp } Masquer des lignes : Range(« A1 »).EntireRow.Hidden = True
Compter le nb de lignes dans une selection : Selection.rows.Count Compter le nb de colonnes dans une selection : Selection.Columns.Count
LES FICHIERS Change l’attribut : SetAttr FichierUNC, attribut Utilise le lecteur D comme lecteur courant = ChDrive « D » Assigne le chemin courant à une variable a a = CurDir crée un dossier dans le dossier courrant = MkDir « mon_dossier » supprime un dossier vide dans le dossier courant = RmDir « mon_dossier » Détruit tous les fichiers .doc du dossier courant = Kill « *.doc » Utilise « c:\temp » comme nouveau dossier courant = ChDir « c:\temp »]
Dim oShellApp As Object: Set oShellApp = CreateObject(« Shell.Application ») ‘Decompresser tous le fichier searchedFile.txt du zip : toto.zip oShellApp.Namespace(« c:\FoundFile »).CopyHere oShellApp.Namespace(« c:\toto\toto.zip »).Items.Item(« searchedFile.txt ») ‘Decompresser tous les fichier du zip : toto.zip oShellApp.Namespace(« c:\FoundFile »).CopyHere oShellApp.Namespace(« c:\toto\toto.zip »).Items
Ouvrir un fichier (en lect seule):open « Fichier.txt » For Input As #1 {fichier n° 1) Le lire Do While Not EoF(1):Line Input #1, Textline : Msgbox textline:loopFermer ce fichier:Close #1 Ouvrir un fichier (ecriture) :open « Fichier.txt » For output As #1 {fichier n° 1) ecrire dedans :liste = 0 : Do While liste < liste = » Liste »> Active une fenetre : Windows(nom_du_fichier).Activate
Sauvegarder un wkbook : ActiveWorkbook.SaveAs Filename:=nom_UNC_du_Fichier, FileFormat:=xlNormal, Password:= » », WriteResPassword:= » », ReadOnlyRecommended:=False, CreateBackup:=False Fermeture d’une fenetre : ActiveWindow.Close Quitter sans enregistrer: Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Close savechanges:=False End Sub Fermeture du classeur : wbExcel.Close Fermeture de l’app Excel: appExcel.Quit Désallocation mémoire : Set wsExcel = Nothing_
Ouverture d’une feuille excel XLS ou csv (les fichiers CSV sont des fichiers textes où une ligne du fichier correspond à une ligne de la feuille et les colonnes sont séparées par des ‘;’) ,45, 4,10,23 Dim appExcel As Excel.Application ‘Définition de l’Application Excel Dim wbExcel As Excel.Workbook ‘Définition du Classeur Excel Dim wsExcel As Excel.Worksheet ‘Définition de la Feuille Excel Set appExcel = CreateObject(« Excel.Application ») ‘Ouverture de l’application Set wbExcel = appExcel.Workbooks.Open(nom_UNC_du_fichier) ‘Ouverture d’un fichier Excel Set wsExcel = wbExcel.Worksheets(1) ‘wsExcel correspond à la première feuille du fichier_
Spécificité d’un fichier texte avec comme séparateur le ‘;’ commençant à la deuxième ligne et au format Windows(ANSI) Dim appExcel As Excel.Application ‘Définition de l’Application Excel Dim wbExcel As Excel.Workbook ‘Définition du Classeur Excel Dim wsExcel As Excel.Worksheet ‘Définition de la Feuille Excel Set appExcel = CreateObject(« Excel.Application »)’Ouverture de l’application Workbooks.OpenText Filename:= nom_UNC_du_fichier, Origin:=xlWindows, StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True ‘Ouverture d’un fichier Excel Set wbExcel=appExcel.ActiveWorkbook Set wsExcel=wbExcel.ActiveSheet_
LES NOMBRES
retourne la val absolue : Abs(-9) = 9 retourne le signe : Sgn(-9) = -1 {-1 0 1 } arrondi a l’entier inférieur : Int(13,9) = 13 et Int(-13,1) = -14 Partie entière : Fix(13,9) = 13 et Fix(-13,1) = -13 nb aléat entre [0 – 1[ : Randomizepour initialiser puis Rdn Modulo : 32 Mod 10 = 2 Puissance : 2^3 = 8 racine carré : SQR(4) = 2 Division complète : 10/3 = 3,33333 Division entière : 10\3 = 3
LA BARRE DE STATUS Application.DisplayStatusBar = True Application.StatusBar = « Message à positionner dans la barre de status »
LES BOITES DE DIALOGUES MSGBOX La fonction MsgBox affiche un message dans une boîte de dialogue, attend que l’utilisateur clique sur un bouton, puis renvoie un entier indiquant le bouton choisi par l’utilisateur
reponse = MsgBox(prompt[,Options][,title][,helpfile, context]) reponse = MsgBox(« Question à poser », vbYesNo + vbCritical + vbDefaultButton, « Titreboite ») Avec option = Type boutons + Style Icône + Bouton par défaut + Modalité de la boite de dialogue
INPUTBOX La fonction InputBox affiche une invite dans une boîte de dialogue, attend que l’utilisateur tape du texte ou clique sur un bouton, puis renvoie le contenu de la zone de texte sous la forme d’une chaîne de caractère. reponse = InputBox(prompt[,title][,default][,xpos][,ypos][,helpfile,context])
valeurs de la variable Type boutons
valeurs de la variable Style Icône
valeurs de la variable Bouton par défaut
valeurs de la variable Modale
valeurs possible de la réponse de la msgbox
LES USERFORMS PréCharger un UserForm : Load UserForm1 Afficher un UserForm : UserForm1.Show Cacher un UserForm : UserForm1.Hide Décharger un UserForm : Unload UserForm1
CheckBoxes Assigner un état clické à une checkBox : Sheets(1).CheckBox1.Value = true
TextBox Remplir un champ : UserForm1.champ1 = « FR » Mettre le focus sur un champ : UserForm1.TextBox13.SetFocus Mettre le focus sur un Bouton : UserForm1.CommandButton1.SetFocus
Ordre de Tabulation Afin de respecter un ordre de tabulation (« Enter » ou « Tab »)
LES EVENEMENTS OnKey Lancer la fonction Launchprg lors d’un appui sur la touche « 1 » : application.onkey « 1 », »launchprg » Ne fais rien lors d’un appui sur la touche « 1 » : application.onkey « 1 », » » Rends sa fonction d’origine à la touche « 1 » : application.onkey « 1 »
GESTION DES ERREURS saute la ligne en cas d’erreur : On Error Resume Next va à la ligne « finprg: » en cas d’erreur : On error Goto finprg xxx xxx xxx xxx finprg: arrete la détéction d’erreur : On Error GoTo 0
L’instruction Exit permet de quitter un bloc Do…Loop : Exit Do L’instruction Exit permet de quitter un bloc For…Next : Exit For L’instruction Exit permet de quitter une Function : Exit function L’instruction Exit permet de quitter un Sub : Exit sub
BOITE A OUTILS Cette boite à outil contient un ensemble de fonctions complètes, prêtes à l’emploi
Recopie des cellules d’un workbook excel non ouvert Utilisation : GetDataFromClosedWorkbook nom_fichier_UNC, « F31:F32 », « A1 », False ) Function GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, TargetRange As range, IncludeFieldNames As Boolean)** _’Requires a reference to the Microsoft ActiveX Data Objects library Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset, dbConnectionString As String Dim TargetCell As range, i As Integer dbConnectionString = « DRIVER={Microsoft Excel Driver (*.xls)}; » & « ReadOnly=1;DBQ= » & SourceFile Set dbConnection = New ADODB.Connection On Error GoTo InvalidInput dbConnection.Open dbConnectionString ‘ open the database connection Set rs = dbConnection.Execute(« [ » & SourceRange & « ] ») Set TargetCell = TargetRange.Cells(1, 1) TargetCell.CopyFromRecordset rs rs.Close dbConnection.Close ‘ close the database connection Set TargetCell = Nothing Set rs = Nothing Set dbConnection = Nothing GetDataFromClosedWorkbook = True On Error GoTo 0 Exit Function InvalidInput: GetDataFromClosedWorkbook = False End Function
Décompresse un fichier existant (ou non) dans l’un des fichiers zip d’un repertoire Sub Unzip(FileSearched, ZipFolder, UnzipFolder) Dim oShellApp As Object: Set oShellApp = CreateObject(« Shell.Application ») Dim oFSO1: Set oFSO1 = CreateObject(« Scripting.FileSystemObject ») Dim oZipFolder As Object: Set oZipFolder = oFSO1.GetFolder(ZipFolder) Dim oFSO2: Set oFSO2 = CreateObject(« Scripting.FileSystemObject ») Dim ZipFile As Variant Dim oZipFile As Object Dim oFileInZipFolder As Object Dim message If (oZipFolder.Files.Count > 0) Then For Each oZipFile In oZipFolder.Files ZipFile = oZipFile.Name If (InStr(1, ZipFile, « .zip », 1) > 0) Then For Each oFileInZipFolder In oShellApp.Namespace(ZipFolder & ZipFile).Items If oFileInZipFolder.Name = FileSearched Then If oFSO1.FileExists(UnzipFolder & FileSearched) Then oFSO1.DeleteFile (UnzipFolder & FileSearched) oShellApp.Namespace(UnzipFolder).CopyHere oShellApp.Namespace(ZipFolder & ZipFile).Items.Item(FileSearched) End If Next End If Next End If Set oShellApp = Nothing: Set oFSO2 = Nothing: Set oZipFolder = Nothing: Set oZipFile = Nothing: Set oFSO1 = Nothing End Sub
Retourne « true » si un fichier existe Private Function FileExist(File As String) As Boolean Dim L As Long On Error GoTo FExErr L = FileLen(File) FileExist = True Exit Function FExErr: FileExist = False Exit Function End Function
Retourne « true » si un fichier existe Private Function FileExist(FileUNC As String) As Boolean FileExist = IIf (Dir(fileUNC) = fileUNC,True, False) End Function
renvoie les valeurs d’une plage de cellules (srcRange) d’une feuille (srcSheet) d’un fichier (srcFile) ferme dans un tableau (outArr) le paramètre TTL indique si la plage a ou non une ligne d’entêtes Utilisation : GetExternalData nomduFichier, sourceSheetname, sourcerange, False, Arr Sub GetExternalData(srcFile As String, srcSheet As String, srcRange As String, TTL As Boolean, outArr As Variant) Dim myConn As ADODB.Connection, myCmd As ADODB.Command Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer Dim Arr Set myConn = New ADODB.Connection If TTL = True Then HDR = « Yes » Else HDR = « No » myConn.Open « Provider=Microsoft.Jet.OLEDB.4.0; » & « Data Source= » & srcFile & « ; » & « Extended Properties= » »Excel 8.0; » &_ « HDR= »&amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp; amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp; amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp;amp; HDR & « ;IMEX=1; » » » Set myCmd = New ADODB.Command myCmd.ActiveConnection = myConn If srcSheet = « » Then myCmd.CommandText = « SELECT * from " & srcRange & " » Else: myCmd.CommandText = « SELECT * from "
&srcSheet & "$" &srcRange & "« Set myRS = New ADODB.Recordset myRS.Open myCmd, , adOpenKeyset, adLockOptimistic ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count) myRS.MoveFirst Do While Not myRS.EOF For RS_n = 1 To myRS.RecordCount ‘lignes For RS_f = 0 To myRS.Fields.Count – 1 ‘colonnes Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value Next myRS.MoveNext Next Loop myConn.Close Set myRS = Nothing Set myCmd = Nothing Set myConn = Nothing outArr = Arr End Sub
Retourne le username de windows Function UserNameWindows() As String Dim lngLen As Long Dim strBuffer As String Const dhcMaxUserName = 255 strBuffer = Space(dhcMaxUserName) lngLen = dhcMaxUserName UserNameWindows = If (CBool(GetUserName(strBuffer, lngLen)) ,Left$(strBuffer, lngLen – 1), » ») End Function_
déplace le curseur de nb positions vers la direction « direction » {Direction = « {LEFT} », « {RIGHT} »} Sub arrowkeyleft(nb,direction) for x = 1 to nb Application.SendKeys « {LEFT} », True Next End Sub
Fermeture Automatique (à mettre dans thiworkbook) Private Sub Workbook_Open() Debut = Now FermAuto End Sub
**Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Debut = Now FermAuto1 End Sub
Exemple à mettre ds un module Option Explicit Public Debut, DebutS, Annul As Byte Declare Sub Sleep Lib « kernel32 » (ByVal dwMilliseconds As Long) Sub FermAuto() DebutS = Debut + TimeValue(« 02:00:00 ») ‘ Modifier ici la durée – actuellement 2 h sec. Application.OnTime DebutS, « FermAuto2 » End Sub
Sub FermAuto1() On Error Resume Next Application.OnTime DebutS, « FermAuto2 », , « False » FermAuto End Sub
Sub FermAuto2() _UserForm1.Show Application.OnTime Now + TimeValue(« 00:00:10 »), « FermAuto3 » End Sub
Sub FermAuto3() _If Annul <> 1 Then ActiveWorkbook.Save On Error Resume Next Application.OnTime DebutS, « Ferauto2 », , « False » ActiveWorkbook.Close End If End Sub
Trouver la position d’un variant dans un array This function returns the index of an item in a one/two-dimensional array. The function returns -1 if the item was not found [value: [Variant] Lookup value] iColumn: (Optional) [Long] If the array has two dimensions, iColumn specifies which column (2nd dimension) will be searched. iStart: (Optional) [Long] Determines where the search will be started.** Function FindInArray(value, vArray As Variant, Optional iColumn, Optional iStart) As Long FindInArray = -1 Dim i As Long, iCol As Long, iSta As Long, iTwo As Long ‘ check if vArray has two dimensions On Error Resume Next i = UBound(vArray, 2) iTwo = IIf(Err.Number = 0, 1, -1) On Error GoTo 0 ‘ check variables If IsMissing(iColumn) Or Not IsNumeric(iColumn) Then iCol = iTwo Else iCol = CLng(iColumn) If IsMissing(iStart) Or Not IsNumeric(iStart) Then iSta = LBound(vArray, 1) Else iSta = CLng(iStart) If iSta < itwo = » -1″ i = » 1″ findinarray = » i » i = » iSta » findinarray = » i »>LanceIE() Dim IE As Object Set IE = CreateObject(« InternetExplorer.Application ») IE.Navigate « http://dj.joss.free.fr« IE.AddressBar = True IE.MenuBar = True IE.Toolbar = True IE.Width = 800 IE.Height = 600 IE.Resizable = True IE.Visible = True Set IE = Nothing End Sub
Donne le num de la semaine de la date fournie Function NOSEM(D As Date) As Long D = Int(D) NOSEM = DateSerial(Year(D + (8 – WeekDay(D)) Mod 7 – 3), 1, 1) NOSEM = ((D – NOSEM – 3 + (WeekDay(NOSEM) + 1) Mod 7)) \ 7 + 1 End Function
The WorkbookIsOpen Function Private Function WorkbookIsOpen(wbname) As Boolean* ‘ Returns TRUE if the workbook is open Dim x As Workbook On Error Resume Next Set x = Workbooks(wbname) If Err = 0 Then WorkbookIsOpen = True Else WorkbookIsOpen = False End Function
Authentification automatique sur un serveur Function mapping(SourceServer) Set oNetwork = CreateObject(« WScript.Network »): Set oDrives = oNetwork.EnumNetworkDrives mapping = False Share = « \ » & SourceServer & « \e$ » For i = 0 To oDrives.Count – 1 Step 2 If LCase(Share) = LCase(oDrives.Item(i + 1)) Then mapping = True: Exit Function Next Dim UserName: UserName = InputBox(« Compte », « Authentification sur » & SourceServer, oNetwork.UserName) Dim Password: Password = « » While Password = « »: Password = InputBox(« mot de passe pour le Compte » & UserName, « Authentification sur » & SourceServer): Wend On Error Resume Next: oNetwork.MapNetworkDrive « », « \ » & SourceServer & « \e$ », True, UserName, Password: On Error GoTo 0 If (Err.Number > 0) Then MsgBox Err.Description Else mapping = True Set oNetwork = Nothing: Set oDrives = Nothing End Function
‘Password masked inputbox API functions to be used Private Declare Function CallNextHookEx Lib « user32 » (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib « kernel32 » Alias « GetModuleHandleA » (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib « user32 » Alias « SetWindowsHookExA » (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib « user32 » (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib « user32 » Alias « SendDlgItemMessageA » (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib « user32 » Alias « GetClassNameA » (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib « kernel32 » () As Long_
Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam): Exit Function strClassName = String$(256, » « ) lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then ‘A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = « #32770 » Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc(« * »), &H0 ‘This changes the edit control so that it display the password character *. End If CallNextHookEx hHook, lngCode, wParam, lParam ‘This line will ensure that any other hooks that may be in place are called correctly. End Function_
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function
Trucs & astuces
Activer l’Auto-Completion, au moment de l’écriture des premiers caractères de l’objet, appuyez sur les touches Ctrl+Espace simultanément. Renforcer la sécurité du code, et forcer la necessité de déclarer chaque variable, il est d’usage de rajouter en début de Module : Option Explicit
LES FONCTIONS D’OPTIMISATION blocage/déblocage des evenements : Application.EnableEvents = False/True Activation/Désactivation du rafraîchissement de l’écran : Application.ScreenUpdating = False/True choix de l’option par défaut pour toutes question : Application.DisplayAlerts = False/True Calculs manuel : Application.Calculation = xlCalculationManual Calculs automatique : Application.Calculation = xlCalculationAutomatic Calculs d’un range : Range(« F2:F8 »).Calculate Démarrage de prog, 5 secondes après avoir lancé Test : Application.OnTime Now + TimeValue(« 00:00:05 »), « prog » OnRepeat, OnUndo, OnWindows
select 'valeur fixe' from table1
select 'valeur fixe' from dual
SELECT – Changer le type de la variable ‘nom’
CONVERT(VARCHAR(200),nom)
SELECT – Liste les éléments de la table
SELECT * FROM Table1
SELECT t1.name AS nom FROM table1 AS t1
SELECT t1.name nom FROM table1 t1
SELECT COUNT(*) FROM table1
INSERT/UPDATE/DELETE – Gestion des lignes dans une table
Insertion : INSERT INTO [nom_base].[nom_table] VALUES ('val-31','val-32','val-33');
Modification : UPDATE Ref.Brand SET InsertDate = '2018-10-24 15:04:57' where BrandCode='CA'
Supression : DELETE FROM [nom_base].[nom_table] WHERE elt1 = 'val-11'
JOIN – Liste les users qui ont une note avec leur note
SELECT * FROM table1 INNER JOIN table2 ON Col1.id = Col2.Col1_id
LEFT OUTER JOIN – Liste les users avec soit leur note associée, soit NULL s’ils n’ont pas de note
SELECT * FROM table1 LEFT OUTER JOIN table2 ON Col1.id = Col2.Col1_id
RIGHT OUTER JOIN – Liste des notes avec soit les users associés à ces notes, soit NULL si aucun user à eu la note
SELECT * FROM table1 RIGHT OUTER JOIN table2 ON Col1.id = Col2.Col1_id
FULL JOIN – Liste de toutes les notes et tous les users avec un NULL sur note lorsque l’user n’a pas de note et un NULL sur user, lorsqu’une note n’est pas attribuée à un user
SELECT * FROM table1 FULL JOIN table2 ON Col1.id = Col2.Col1_id
UNION – Liste toutes les id des users des lycées 1 et 2 y compris. Ceux qui sont inscrits aux deux lycées apparaissent 1 fois
SELECT table1.id FROM table1 UNION SELECT table2.id FROM table2
UNION ALL – éléments des lignes qui apparaissent dans la table 1 et dans la table 2 tables 1 et 2 des id de users des lycées 1 et 2 => liste toutes les id des users des lycées 1 et 2 y compris. Ceux qui sont inscrits aux deux lycés apparaissnet 2 fois
SELECT table1.id FROM table1 UNION ALL SELECT table2.id FROM table2
COUNT – nb d’utilisateurs dans la table 1
SELECT COUNT(name) FROM table1
DISTINCT – nb d’utilisateurs ayant un nom différent dans la table 1
SELECT COUNT(name distinct) FROM table1
GROUP BY – nb d’utilisateurs par titre dans la table 1
SELECT title, COUNT(*) FROM table1 GROUP by title
MAX – Employé le plus jeune de l’entreprise
SELECT MAX(birth_date) FROM employees;
LIKE – liste des employés
SELECT name FROM employees WHERE name LIKE '%nico%';
Arithmetique – liste des employés
SELECT name FROM employees WHERE number ='1' AND number >='1' AND number >'1' AND number !='1'
subqueries – liste des employés
SELECT name FROM employees WHERE city IN (SELECT DISTINCT city FROM loc WHERE city like %pari%)
SQL Dynamique
DECLARE @sql varchar(Max)
Set @sql = 'SELECT * from Ref.Brand'
PRINT @sql
EXEC (@sql);
CREATE TABLE – Gérer une table dans un schéma
Créer une table : CREATE TABLE [dbo].[test] (id INT NOT NULL PRIMARY KEY, nom varchar(100),);
Supprimer une table : Drop TABLE [dbo].[test]
ALTER TABLE – Gérer les colonnes d’une table
Ajouter une colonne : ALTER TABLE [dbo].[test] ADD age varchar(10);
Modifier le format d'une colonne : ALTER TABLE [dbo].[test] ALTER COLUMN age varchar(20);
Supprimer une colonne : ALTER TABLE [dbo].[test] DROP COLUMN age ;
Taille des tables d’une base SQL
SELECT S.name + '.' + T.name AS tableName, T.create_date As creationDate, SUM(PS. row_count) AS nbRows, SUM(PS.reserved_page_count) * 8192 AS tableSize
FROM sys.dm_db_partition_stats AS PS
INNER JOIN sys.tables AS T ON PS.object_id = T.object_id
INNER JOIN sys.schemas AS S ON S.schema_id = T.schema_id
WHERE PS.index_id BETWEEN 0 AND 1 AND T.name <> 'sysdiagrams'
GROUP BY S.name, T.name, T.create_date
Mission de 15 mois [01/2016 – 04/2017] sous la responsabilité du directeur de la Business Unit Digitale (Eric PROVENSAL)
Projet de déploiement international du site web e-Commerce Yves Rocher France, nom de code EASY , visant à constituer la solution multi-marques et multi-pays du groupe. Objectif n°1 : déploiement en Allemagne, Suisse, Autriche et Russie.
Enjeux & KPI: Réduction du coût opérationnel, centralisation de la gestion des produits, suppression des limites de l’ancien site. Coûts programme > 10 M€Fréquentation du site > 50K connexions/jours
Pilotage d’équipes dédiées:
Fonctionnelle (5p),
Gestion du changement pour les pays déployés (2p),