Access vers Excel

Le 26/08/2019 à 18:41

Bonjour tout le monde,

Voila cela fait quelques jours que je cherche une solution pour extraire un formulaire sur Access vers un feuille Excel automatiquement quand j'appuie sur un Bouton sur la feuille Excel.

Voici ou ce trouve ma base Access \\SSIGWP0101\Peinture\EPP\gestion stock peinture\BD Gestion du stock peinture 1.1.mdb

Puis ensuite j'aimerais transferer juste un Formulaire qui s'appelle "70 bis Choix du produit à préparer" (voir photo formulaire en Orange"

J'aimerais qu"il s'enregistre sur D:\Personal\vincent.dupre2\70 bis Choix du produit à préparer.xlsx

Quand je clic sur un bouton

Le 27/08/2019 à 09:38

Bonjour Brutus01,

Peux-tu préciser :

Si à chaque choix de produit fait dans ACCESS, les lignes doivent se cumuler dans l'EXCEL?
Quelles informations sont à reporter de l'ACCESS vers l'EXCEL?

Le 27/08/2019 à 10:14

Bonjour Gvialles,

Déjà je tiens à te remercier d'avoir pris le temps de lire mon post.

J'ai besoin que sa extrait la totalité du formulaire, comme si on faisait 'données externes' 'excel' exporter vers une feuille de calcul ...

Voir photo

Le 27/08/2019 à 13:05

9capture.xlsx (414.02 Ko)

Le 27/08/2019 à 16:55

Brutus01,

Je te propose de coller le code suivant dans ton formulaire ACCESS :

Private Sub Form_DblClick(Cancel As Integer)
    Const cEXCELFilemane = "D:\Personal\vincent.dupre2\70 bis Choix du produit à préparer.xlsx"

    Dim oFS As Object
    Dim oWB As Object
    Dim oSheet As Object
    Dim oXL As Object

    Dim oSelectedRow As Recordset
    Dim oFields As Fields
    Dim oField As Field

    Dim lRow As Long, booFileOpened As Boolean

    'On créé une instance FileSytemObject
    Set oFS = CreateObject("Scripting.FileSystemObject")

    'On récupère la ligne sélectionnée dans la formulaire
    Set oSelectedRow = Form.Recordset

    'On s'assure de l'existence du fichier excel de destination
    If Not oFS.FileExists(cEXCELFilename) Then
        'S'il n'existe pas on le crée
        Set oXL = CreateObject("Excel.Application")
        Set oWB = oXL.Workbooks.Add
        oWB.Saveas cEXCELFilename
        'On référe la première feuille du classeur
        Set oSheet = oWB.WOrksheets(1)
        'On renseigne la ligne d'entête
        For Each oField In oSelectedRow.Fields
            oSheet.Cells(1, oField.OrdinalPosition + 1) = oField.Name
        Next
    Else
        'S'il existe, on l'ouvre
        Set oXL = GetObject(cEXCELFilename).Application
        Set oWB = oXL.Workbooks.Open(cEXCELFilename)
        'On référe la première feuille du classeur
        Set oSheet = oWB.WOrksheets(1)
    End If

    'On ajoute les données de la ligne sélectionnée dans l'EXCEL
    lRow = oSheet.Usedrange.Rows.Count
    For Each oField In oSelectedRow.Fields
        oSheet.Cells(lRow + 1, oField.OrdinalPosition + 1) = oField.Value
    Next

    'On sauve l'EXCEL
    oWB.Close True
    'On cloture l'instance EXCEL
    oXL.Quit

    'On fait le ménage
    Set oXL = Nothing
    Set oWB = Nothing
    Set oFS = Nothing
    Set oSheet = Nothing
End Sub
Function ExcelAlreadyOpened(zFile As String) As Boolean
    Dim oApp As Object
    Set oApp = GetObject(zFile).Application

    If oApp Is Nothing Then
        ExcelAlreadyOpened = False
    Else
        ExcelAlreadyOpened = True
    End If

    Set oApp = Nothing
End Function

Le 27/08/2019 à 17:50

est-il possible de faire la même chose mais en VBA Excel non sur Access ?

car la base Access concerné est utilisé par beaucoup de monde et ils n'aiment quand on modifie ou touche a leur fichier.

Le 28/08/2019 à 14:41

Bonjour Brutus01,

En ce cas, je te propose le code suivant à activer dans EXCEL par un bouton :

Option Explicit
Const cMSACCESSDataBaseName = "\\SSIGWP0101\Peinture\EPP\gestion stock peinture\BD Gestion du stock peinture 1.1.mdb"
Const cFormName = "70 bis Choix du produit à préparer"
Sub Bouton1_Cliquer()
    Dim oDB As Access.Application
    Dim oForm As Access.Form
    Dim oSelectedRow As Object
    Dim oField As Object
    Dim oSheet As Worksheet
    Dim lRow As Long

    If AccessBaseIsActive Then
        Set oDB = GetObject(, "Access.Application")
        If oDB.Screen.ActiveForm.Name = cFormName Then
            Set oForm = oDB.Screen.ActiveForm
            Set oSelectedRow = oForm.Recordset
            Set oSheet = ThisWorkbook.ActiveSheet

            lRow = oSheet.Cells(oSheet.Rows.Count, 1).End(xlUp).Row
            'On ajoute les données de la ligne sélectionnée dans l'EXCEL
            For Each oField In oSelectedRow.Fields
                oSheet.Cells(lRow + 1, oField.OrdinalPosition + 1) = oField.Value
            Next
            ThisWorkbook.Save
        End If
    Else
        MsgBox "L'application ACCESS n'est pas active!", vbExclamation
    End If

End Sub
Function AccessBaseIsActive() As Boolean

    Dim oApp As Object
    Dim oDB As Object

    On Error Resume Next
    Set oApp = GetObject(, "Access.Application")

    If Not oApp Is Nothing Then
        If InStr(1, oApp.ADOConnectString, cMSACCESSDataBaseName) > 0 Then
            'Set oDB = GetObject(cMSACCESSDataBaseName)
            AccessBaseIsActive = True
        Else
            AccessBaseIsActive = False
        End If
    Else
        AccessBaseIsActive = False
    End If

    Set oApp = Nothing
    On Error GoTo 0
End Function

Le 28/08/2019 à 15:11

Merci beaucoup pour ton aide, je vais essayer ça des demain matin.

Le 29/08/2019 à 08:15

Salut GVialles,

Ca fonctionne à peut pret je suis bloqué sur "l'application n'est pas ACTIVE"

Le 29/08/2019 à 08:17