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

