2021→23 | GROUPE AGRICA

En passant

Directeur de projet

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 ans Cout programme  ≈ 2 M€ 

Equipes impliquées :

  • DSI AGRICA: Architecture, Qualification, Charge, Digital, Data, Prod, Réseau, …
  • 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.

Partenaires externes sollicités

Compétences mises en oeuvre

  • Cadrage & gestion des partis-pris
  • Fort accompagnement métier
  • Définition et pilotage de la roadmap projet.
  • Coordination directe des acteurs.
  • Gestion des risques et participation aux comités de pilotage groupe
  • Tenue des comités de pilotage IT

Technologies/Méthodes utilisées :

  • Mix projet : Cycle en V + Méthodes agiles

VBA – VBS

En passant

LES CONSTANTES
Syntaxe : Const ExConstante = 0

Tableaux statiques de constantes
ListeJours = Array(« Lundi », »Mardi », …. , »Vendredi », »Samedi »)
valeur minimale des index du tableau : LBound(ListeJours) = 0
valeur maximale des index du tableau : UBound(ListeJours) = 6

Exemples de constantes

bleufonce = 47: mauve=39: vert=35: jaune=19: orange=40: rouge0=22 : rouge1=3 : violet=39: bleu0=24: bleu1=17: bleu2=47 : blanc=2: gris20=15: gris40=48: gris60=16 : gris80=56: noir=1: rose=38: marron=53: vertfonce=14

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

Picture

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)

Picture

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

LES TRIS des cellules

range("D1:D6").Sort Key1:=Range(myrange), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,DataOption1:=xlSortNormal  
Selection.Sort Key1:=Range(Cells(startline, Column\_selected), Cells(Endline,Column\_selected)),  
Order1:=xlAscending, Key2:=Range(Cells(startline,ConsoCat\_status.column), Cells(Endline, ConsoCat\_status.column)),  
Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,  
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal,
DataOption3:=xlSortNormal

LES BOUCLES

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

Les converssions
Conv : CBool(), CByte(), CCur(), CDate(), CDbl(), CDec(), CInt(), CLng(), Csng(), Cstr(), Cvar()

LES STRUCTURES CONDITIONNELLES

IF THEN ELESE

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

LES COULEURS
Picture

LES CELLULES

IsNumeric(), IsDate(), IsEmpty()  
Cells(1,3) = range("a3") = \[a3\]  
Couleur_de_la_police_de_caractère = cells(x,y).Font.ColorIndex  
Couleur_de_fond = cells(x,y).Interior.ColorIndex  
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

Picture

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

LES TABLES DE VERITE
[Picture]

IMPRESSION

Sheets(1).PageSetup.LeftFooter = « &Bcommentaire_de_gauche&B »
Sheets(1).PageSetup.CenterFooter = « &8Page &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;amp;P & of &N »
Sheets(1).PageSetup.RightFooter = « &8Last Saved : &B » & ActiveWorkbook.BuiltinDocumentProperties(« Last save time »)
ActiveSheet.PageSetup.PrintArea = « $B$2:$AH$9 »
ActiveSheet.PrintOut Copies:=1, Collate:=True
Range(« A1:D4 »).PrintOut

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])

Picture

valeurs de la variable Type boutons
Picture

valeurs de la variable Style Icône
Picture

valeurs de la variable Bouton par défaut
Picture

valeurs de la variable Modale
Picture

valeurs possible de la réponse de la msgbox
Picture

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 »)
Picture
Picture

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

Importe un fichier CSV dans une feuille Excel
Sub importCSVfile(file)
Sheets(« Transfert »).Range(« A1:BB500 »).ClearContents
With Sheets(« Transfert »).QueryTables.Add(Connection:= »TEXT;C:\Report.csv », Destination:=Sheets(« Transfert »).Range(« A1 »))
.Name = « Report »
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 4, 4, 4, 4, 2)
.Refresh BackgroundQuery:=False
End With
Sheets(« Transfert »).Range(« N1 »).FormulaR1C1 = « User »
End Sub_

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

Picture
Trucs & astuces
Picture

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

SQL

En passant

valeur fixe – afficher une valeur fixe

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

Tutos : https://www.w3schools.com/sql/default.asp

2016→17 | Yves ROCHER

En passant

Directeur de projet digital

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),
  • Expertise & conception applicative (3p),
  • Recette (7p),
  • Content load (3p)
  • Intégration logicielle (30p).

la suite…