Client: E3M (France)
Date: Janvier-Avril 2016
Technlogie: Access, VBA, Excel, Word
Développée pour la compagnie Bio-Rad, cette base de données permet de faire le suivi des produits concurrents. Vous retrouvez la liste des produits Bio-Rad ainsi qu'une liste de produits concurrents. Chaque produit concurrent est lié à un ou plusieurs produits Bio_Rad avec des commentaires pour chacun. Des documents relatifs à ces produits peuvent aussi être joints. Des informations générales sont aussi gérées par cette base de données. Des fonctions d'exportation vers Excel et Word ont aussi été développées.
Vous retrouvez aussi les fonctions pour gérer les différentes tables et ainsi qu'un sytème de gestion des accès et un rapport des activités sur la base de données.
Cette fonction permet de lier un document à un produit concurrent ou une information générale. Les documents sont copiés dans un dossier spécifique nommé selon l'identifiant du produit
concurrent ou de l'information générale.
Function InsertDocumentLink(DocumentType As String, IDDocument As Long, DocumentName As String, Optional Confidential As Boolean = False) As Boolean Dim strTableName As String Dim strIDName As String Dim intActivityType As LogActivityTypeID Dim strActivityDescription As String Dim db As Database Dim rs As DAO.Recordset Dim sSQL As String Dim bReturnValue As Boolean bReturnValue = False Select Case DocumentType Case "ConcurrentProduct" strTableName = "ProduitConcurrent_Documents" strIDName = "IDProduitConcurrent" intActivityType = AddConcurrentProductDocument strActivityDescription = "Document " & DocumentName & " added to concurrent product " & modMain.GetConcurrentProductName(IDDocument) Case "GeneralInfo" strTableName = "InfoGenerale_Documents" strIDName = "IDInfoGenerale" intActivityType = AddGeneralInfoDocument strActivityDescription = "Document " & DocumentName & " added to general information " & modMain.GetGeneralInfoTitle(IDDocument) Case Else strTableName = "" strIDName = "" End Select If strTableName <> "" Then Set db = CurrentDb sSQL = "INSERT INTO [" & strTableName & "] (" & strIDName & ", DocumentFilename, ProprietaryID, IsConfidential) VALUES (" & _ IDDocument & ",'" & DocumentName & "'," & gCurrentLogUserID & "," & xBoolean(Confidential) & ")" db.Execute sSQL Call modMain.SetActivityLog(intActivityType, strActivityDescription) Set db = Nothing bReturnValue = True End If InsertDocumentLink = bReturnValue End Function
Cette fonction permet filtrer la liste des produits concurrents selon différents critères.
Private Sub FilterData() Dim sSQL As String Dim sSQLWhere As String Dim sSQLOrderBy As String sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _ "Concurrent_Enterprise.ConcurrentEnterpriseName AS Entreprise FROM Produits_Concurrent " & _ "LEFT JOIN Concurrent_Enterprise ON Produits_Concurrent.IDConcurrentEnterpriseName = Concurrent_Enterprise.ID_ConcurrentEnterprise " sSQLOrderBy = " ORDER BY Produits_Concurrent.[NomProduitConcurrent]" FilterDataType = "All" 'Filter by Bio-Rad Product Code If Not IsNull(Me.cboProduits_Bio_RAd.Value) Then sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _ "Concurrent_Enterprise.ConcurrentEnterpriseName As Entreprise " & _ "FROM Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent INNER JOIN Produit_BioRad_Lie " & _ "ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _ "ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _ "ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName " sSQLWhere = "WHERE (((Produit_BioRad_Lie.IDProduitBioRad)=" & Me.cboProduits_Bio_RAd.Value & "))" FilterDataType = "Product Code=" & Me.cboProduits_Bio_RAd.Column(1) End If If Trim(Me.tboProductName) <> "" Then sSQL = "SELECT DISTINCT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _ "Concurrent_Enterprise.ConcurrentEnterpriseName As Entreprise " & _ "FROM Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent INNER JOIN Produit_BioRad_Lie " & _ "ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _ "ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _ "ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName " sSQLWhere = "WHERE (([Produits_Bio-Rad].NomProduit LIKE '*" & Trim(tboProductName) & "*'" & "))" FilterDataType = "Product Name=" & Trim(tboProductName) End If If Not IsNull(Me.cboItemGroups.Value) Then sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _ "Concurrent_Enterprise.ConcurrentEnterpriseName AS Entreprise, ItemGroups.IDItemGroup " & _ "FROM (Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent " & _ "INNER JOIN Produit_BioRad_Lie ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _ "ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _ "ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName) " & _ "INNER JOIN ItemGroups ON [Produits_Bio-Rad].IDItemGroup = ItemGroups.IDItemGroup " sSQLWhere = "WHERE (((ItemGroups.IDItemGroup)=" & Me.cboItemGroups.Value & "))" FilterDataType = "Item Groups=" & Me.cboItemGroups.Column(1) End If If Not IsNull(Me.cboListeEntreprise.Value) Then If sSQLWhere = "" Then sSQLWhere = " WHERE Concurrent_Enterprise.ConcurrentEnterpriseName ='" & Me.cboListeEntreprise.Column(1) & "'" Else sSQLWhere = sSQLWhere & " AND Concurrent_Enterprise.ConcurrentEnterpriseName ='" & Me.cboListeEntreprise.Column(1) & "'" End If If FilterDataType = "All" Then FilterDataType = "Entreprise=" & Me.cboListeEntreprise.Column(1) Else FilterDataType = FilterDataType & " AND Entreprise=" & Me.cboListeEntreprise.Column(1) End If End If Me.Liste1.RowSource = sSQL & sSQLWhere & sSQLOrderBy Me.Liste1.Requery End Sub
Cette fonction permet d'exporter la liste des produits concurrents vers Excel.
Private Sub ExportToExcel() Dim oExcel As Excel.Application Dim oWorkBook As Excel.Workbook Dim oWorksheet As Excel.Worksheet Dim i As Integer Dim j As Integer Dim strColumnNo As String Set oExcel = CreateObject("Excel.Application") oExcel.Visible = True Set oWorkBook = oExcel.Workbooks.Add() Set oWorksheet = oWorkBook.Sheets.Add 'Titles oWorksheet.Cells(1, 1) = "Competitive Product List" oWorksheet.Range("A1").RowHeight = 24 oWorksheet.Range("A1").Font.Size = 18 oWorksheet.Range("A1").Font.Bold = True oWorksheet.Range("A1").HorizontalAlignment = xlCenter oWorksheet.Range("A1:" & Chr(Asc("A") + (Me.Liste1.ColumnCount - 2)) & "1").Merge oWorksheet.Cells(2, 1) = "Criteria: " & FilterDataType oWorksheet.Range("A2").RowHeight = 36 oWorksheet.Range("A2").Font.Size = 12 oWorksheet.Range("A2").Font.Bold = True oWorksheet.Range("A2").VerticalAlignment = xlCenter 'Column Header strColumnNo = "A" For i = 1 To Me.Liste1.ColumnCount - 1 oWorksheet.Range(strColumnNo & "1").ColumnWidth = 40 oWorksheet.Range(strColumnNo & "4").Font.Bold = True oWorksheet.Cells(4, i) = Me.Liste1.Column(i, 0) strColumnNo = Chr(Asc(strColumnNo) + 1) Next i 'Data For j = 1 To Me.Liste1.ListCount - 1 strColumnNo = "A" For i = 1 To Me.Liste1.ColumnCount - 1 oWorksheet.Cells(j + 4, i) = Me.Liste1.Column(i, j) strColumnNo = Chr(Asc(strColumnNo) + 1) Next i Next j oWorksheet.Range("A1").Select 'oWorkBook.SaveAs strFilename 'Release objects Set oExcel = Nothing Set oWorksheet = Nothing Set oWorkBook = Nothing End Sub