Ms-Access exporter des données de formulaire à Word

Question

J'ai vraiment un peu d'aide! Voici un lien vers un fichier google drive zip de la base de données d'accès avec laquelle je me bats. Donc, ce que j'ai, c'est une base de données d'accès composée de quelques tables et d'un formulaire et de quelques sous-formulaires. Les informations de la base de données sont entrées dans les tables via un formulaire que j'ai créé. Dans l'exemple, le formulaire s'appelle "Database". Ce formulaire exporte vers un document Word, les champs de la base de données vont vers des signets sur le mot doc. Cela fonctionne très bien jusqu'à présent.

Dans la pièce jointe il y a un dossier "modèle" avec le document Word d'origine, lorsque le code s'exécute, il enregistre le formulaire complété dans le dossier "généré" - fonctionne comme un charme. C'est une forme très longue pour les demandes de permis d'alcool.

Ainsi, vous remplissez le formulaire en accès, il enregistre dans les tables et exporte les données dans le document de modèle de mot. Le problème que j'ai est qu'il ya un sous-formulaire sur l'onglet 8 du formulaire où les "détails du directeur" sont enregistrés. Il peut y avoir un nombre quelconque de directeurs par application. J'ai réussi à accéder aux données de la table du sous-formulaire, mais je n'ai aucune idée de comment faire une boucle dans les données de cette table pour obtenir toutes les informations applicables à cette application uniquement et pas les données liées à d'autres applications. Il existe une relation entre la table des détails du directeur et la table des détails de l'application (c'est la table principale) et j'utilise un champ d'identifiant d'application que j'ai créé appelé et "ACNumber" qui est unique à chaque application. Il y a un combobox sur le formulaire qui sélectionne l'application et le formulaire et les sous-formulaires affichent les données correctes lorsque vous le sélectionnez.

L'autre partie du problème est comment puis-je afficher ce mot? Un signet ne fonctionnera pas, car tous les champs sont répétés. Est-il possible que toutes les entrées de données puissent être sorties vers un seul signet mabe dans une zone de texte avec les étiquettes?

Voici comment il regarde la forme mot de document:

(première personne)
Nom complet: générer du point 5.4 (a) la base de données Adresse physique: générer du point 5.4 (b) de la base de données Code postal: générer de l'article 5.4 (c) de la base de données Code postal: générer de l'article 5.4 (d) à partir de la base de données Code postal: générer du point 5.4 (e) de la base de données Numéro d'identité: générer du point 5.4 (f) base de données

(Plus d'information rson à ajouter si nécessaire)

Ok, j'espère que cela décrit mon problème avec précision. J'ai essayé toutes sortes de choses pour que ça fonctionne, mais c'est au-delà de moi, s'il vous plaît, aidez les gars !!! Ci-dessous le code que j'utilise: (la boucle pour le sous-formulaire ne fonctionne pas, mais une entrée de cette table est exportée vers les signets actuellement en place) J'ai essayé toutes sortes de choses pour que cela fonctionne, mais C'est au-delà de moi, s'il vous plaît, aidez les gars !!!

---

`Private Sub ExportToWord_Click() 

'Print customer slip for current customer. 
    Dim appWord As Word.Application 
    Dim doc As Word.Document 
    Dim drst As Recordset 
    Set drst = CurrentDb.OpenRecordset(Name:="62 Other Interests", Type:=RecordsetTypeEnum.dbOpenDynaset) 
    'Avoid error 429, when Word isnt open. 
    On Error Resume Next 
    Err.Clear 
    'Set appWord object variable to running instance of Word. 
    Set appWord = GetObject(, "Word.Application") 

    If Err.Number <> 0 Then 
    'If Word isnt open, create a new instance of Word. 
    Set appWord = New Word.Application 
    End If 
    Set doc = appWord.Documents.Open("C:\forms\templates\Form 3 - Sec 36(1).docx", , True) 
    With doc 
    .Bookmarks("wAppTradingNames").Range.Text = Nz(Me!AppTradingName, "") 
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "") 
    .Bookmarks("wCompanyName").Range.Text = Nz(Me!CompanyName, "") 
    .Bookmarks("wCompanyNumber").Range.Text = Nz(Me!CompanyNumber, "") 
    .Bookmarks("wRAddress1").Range.Text = Nz(Me!RAddress1, "") 
    .Bookmarks("wPostalCode").Range.Text = Nz(Me!PostalCode, "") 
    .Bookmarks("wRPostalAddress1").Range.Text = Nz(Me!RPostalAddress1, "") 
    .Bookmarks("wRPostalCode").Range.Text = Nz(Me!RPostalCode, "") 
    .Bookmarks("wDomicilium1").Range.Text = Nz(Me!Domicilium1, "") 
    .Bookmarks("wDomiciliumCode").Range.Text = Nz(Me!DomiciliumCode, "") 
    .Bookmarks("wDomAfter1").Range.Text = Nz(Me!DomAfter1, "") 
    .Bookmarks("wDomAfterCode").Range.Text = Nz(Me!DomAfterCode, "") 
    .Bookmarks("wTelOffice").Range.Text = Nz(Me!TelOffice, "") 
    .Bookmarks("wTelCell").Range.Text = Nz(Me!TelCell, "") 
    .Bookmarks("wTelHome").Range.Text = Nz(Me!TelHome, "") 
    .Bookmarks("wFaxNumber").Range.Text = Nz(Me!FaxNumber, "") 
    .Bookmarks("wEmail").Range.Text = Nz(Me!Email, "") 
    .Bookmarks("wFIP").Range.Text = Nz(Me!FIP, "") 
    .Bookmarks("wAppLicCat").Range.Text = Nz(Me!AppLicCat, "") 
    .Bookmarks("wLiqourType").Range.Text = Nz(Me!LiqourType, "") 
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "") 
    .Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "") 
    .Bookmarks("wLPAddress").Range.Text = Nz(Me!LPAddress, "") 
    .Bookmarks("wErfNumber").Range.Text = Nz(Me!ErfNumber, "") 
    .Bookmarks("wLPPostalCode").Range.Text = Nz(Me!LPPostalCode, "") 
    .Bookmarks("wLPOwnership").Range.Text = Nz(Me!LPOwnership, "") 
    .Bookmarks("wLPOwnersName").Range.Text = Nz(Me!LpOwnersName, "") 
    .Bookmarks("wLpOwnerAddress").Range.Text = Nz(Me!LpOwnerAddress, "") 
    .Bookmarks("wLpRightOccupation").Range.Text = Nz(Me!LpRightOccupation, "") 
    .Bookmarks("wLPOccDuration").Range.Text = Nz(Me!LPOccDuration, "") 
    .Bookmarks("wLpPremNotErected").Range.Text = Nz(Me!LpPremNotErected, "") 
    .Bookmarks("wLpPremAlterReq").Range.Text = Nz(Me!LpPremAlterReq, "") 
    .Bookmarks("wLpPremAllGood").Range.Text = Nz(Me!LpPremAllGood, "") 
    .Bookmarks("wLpBuildCommence").Range.Text = Nz(Me!LpBuildCommence, "") 
    .Bookmarks("wLpBuildDuration").Range.Text = Nz(Me!LpBuildDuration, "") 
    .Bookmarks("wLpTradingHours").Range.Text = Nz(Me!LpTradingHours, "") 
    .Bookmarks("wLpRenewal").Range.Text = Nz(Me!LpRenewal, "") 
    .Bookmarks("wLpJobsa").Range.Text = Nz(Me!LpJobsa, "") 
    .Bookmarks("wLpJobsB").Range.Text = Nz(Me!LpJobsB, "") 
    .Bookmarks("wLpJobsC").Range.Text = Nz(Me!LpJobsC, "") 
    .Bookmarks("wNNPRegName").Range.Text = Nz(Me!NNPRegName, "") 
    .Bookmarks("wNNPRegNumber").Range.Text = Nz(Me!NNPRegNumber, "") 
    .Bookmarks("wNNPRegDate").Range.Text = Nz(Me!NNPRegDate, "") 
    .Bookmarks("wOtherInterests").Range.Text = Nz(drst!OtherInterests, "") 
    .Visible = True 
    .Activate 
    End With 

    Dim rst As Recordset: Set rst = CurrentDb.OpenRecordset(Name:="5 Director Details", Type:=RecordsetTypeEnum.dbOpenDynaset) 
    'Do While Not rst.EOF 
    With doc 
     .Bookmarks("wPersonLabel").Range.Text = Nz(rst!PersonLabel, "") 
     .Bookmarks("wFullName").Range.Text = Nz(rst!FullName, "") 
     .Bookmarks("wPhAddress").Range.Text = Nz(rst!PhAddress, "") 
     .Bookmarks("wPhCode").Range.Text = Nz(rst!PhCode, "") 
     .Bookmarks("wPAddress").Range.Text = Nz(rst!PAddress, "") 
     .Bookmarks("wPCode").Range.Text = Nz(rst!PCode, "") 
     .Bookmarks("wIdNumber").Range.Text = Nz(rst!IdNumber, "") 
     .Visible = True 
     .Activate 
     rst.MoveNext 
    End With 
    'Loop 

    doc.SaveAs2 "C:\forms\generated\" & Me!ACNumber & "_Form 3 - Sec 36(1).docx" 
    Set doc = Nothing 
    Set appWord = Nothing 
    Exit Sub 

errHandler: 
    MsgBox Err.Number & ": " & Err.Description 

End Sub 


` 

Answer 1

Cela vous pointera vers la bonne direction. Vous devez apporter quelques modifications pour répondre à vos besoins, par exemple. insérez tous vos signets, mettez à jour les champs SQL et recordset.

Vous devez également faire quelques changements dans votre document Word si:

1) Ajouter une table pour contenir les données gestionnaire (boucle). Cachez les bordures si nécessaire.
2) Enregistrez le document en tant que modèle Word (.dotx)

Public Sub ExportToWord() 
    On Error GoTo ErrorTrap 

    Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).dotx" 

    'Data 
    Dim rs As DAO.Recordset 
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot) 

    'SaveAs 
    Dim name_ As String 
     name_ = "C:\forms\generated\" & rs![FieldName] & "_Form 3 - Sec 36(1).docx" 

    'Word 
    Dim oWord As Word.Application 
    Set oWord = New Word.Application 
     oWord.Visible = False 

    Dim oDoc As Word.Document 
    Set oDoc = oWord.Documents.Add(TemplatePath) 
    With oDoc 
     .Bookmarks("Bookmark_1").Range.Text = rs![FieldName_1] 
     .Bookmarks("Bookmark_2").Range.Text = rs![FieldName_2] 
     .Bookmarks("Bookmark_3").Range.Text = rs![FieldName_3] 
     '... 
    End With 

     rs.Close 
    Set rs = Nothing 

    'Loop data 
    Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot) 
    With rs 
     If Not .EOF Then 
      .MoveLast 
      .MoveFirst 
     End If 
    End With 

    Dim idx As Integer 
    For idx = 1 To rs.RecordCount 
     With oDoc.Tables(1) 
      .Cell(idx, 1).Range.Text = rs![FieldName_1] '1st Column 
      .Cell(idx, 2).Range.Text = rs![FieldName_2] '2nd Column 
      .Cell(idx, 3).Range.Text = rs![FieldName_1] '3rd Column 
      '... 
      'add extra rows if required 
      If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add 
     End With 
     rs.MoveNext 
    Next idx 

    'Save 
    With oDoc 
     .SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument 
     .Close SaveChanges:=wdDoNotSaveChanges 
    End With 

Leave: 
    On Error Resume Next 
     rs.Close 
    Set rs = Nothing 
     oWord.Quit 
    Set oWord = Nothing 
    On Error GoTo 0 
    Exit Sub 

ErrorTrap: 
    MsgBox Err.Description, vbCritical, "ExportToWord()" 
    Resume Leave 
End Sub