Hallo,
ich habe folgendes Problem.
Hab auch im Forum gesucht aber nichts passendes gefunden.
Ich habe eine Datenbank mit einem Formular in dem ein Unterformular ist.
Das Formular heist frmOfferten und das Unterformular heist frmArtikelOfferte mit den Datenfeldern "IKS", "Bezeichnung" und "Generik".
Die Tabellen-Datenfelder "Bezeichnung" und "Generik" aus dem Unterformular möchte ich in ein schon geöffnetes Word dokument einfügen.
Ich habe leider nicht soviel ahnung von VBA
Ich hatte mir das folgendermassen vorgestellt.
Ich Drücke einen Button und anschließend werden alle Datensätze des gewählten Unterformulares in mein Worddokument kopiert.
Mit dem beigefügten Code hatte ich schon erfolg. Aber leider wird hier ein neues Word-Dokument geöffnet.
Wie gesagt mein Word-Dokument ist schon offen
Des Weiteren werden auch bei diesem Code leere Felder nicht übertragen bzw. es wird an der Stelle Abgebrochen.
Hat einer einen Tipp
Gruß Edgar
ich habe folgendes Problem.
Hab auch im Forum gesucht aber nichts passendes gefunden.
Ich habe eine Datenbank mit einem Formular in dem ein Unterformular ist.
Das Formular heist frmOfferten und das Unterformular heist frmArtikelOfferte mit den Datenfeldern "IKS", "Bezeichnung" und "Generik".
Die Tabellen-Datenfelder "Bezeichnung" und "Generik" aus dem Unterformular möchte ich in ein schon geöffnetes Word dokument einfügen.
Ich habe leider nicht soviel ahnung von VBA
Ich hatte mir das folgendermassen vorgestellt.
Ich Drücke einen Button und anschließend werden alle Datensätze des gewählten Unterformulares in mein Worddokument kopiert.
Mit dem beigefügten Code hatte ich schon erfolg. Aber leider wird hier ein neues Word-Dokument geöffnet.
Wie gesagt mein Word-Dokument ist schon offen
Des Weiteren werden auch bei diesem Code leere Felder nicht übertragen bzw. es wird an der Stelle Abgebrochen.
PHP:
Private Sub DokumentFRZ_Click()
Dim rs As DAO.Recordset
Dim i As Integer
Dim wordobj As word.Application
Dim worddoc As word.Document
Dim objBMRange As word.Range
Dim VORLAGE As String
Dim FS As FileSearch
Dim test As Integer
Dim Lesefiles As String
Dim Laufwerksordner As String
Dim strBMName As String
Dim strBMText As String
Dim strText As String
Vorlagenordner = Application.CurrentProject.Path
Set FS = Application.FileSearch
With FS
.LookIn = Vorlagenordner
Debug.Print Vorlagenordner
.NewSearch
.SearchSubFolders = False
'Filter für *.doc einstellen
.FileName = "*.doc*"
.Execute
For i = 1 To .FoundFiles.Count
Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
Next i
End With
'Me!Dokument.RowSourceType = valuelist
Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
Laufwerksordner = Vorlagenordner & "\" & Me!DokumentFRZ
'Start Microsoft Word.
Set wordobj = CreateObject("Word.Application")
'Vorlage erstellen. Dadurch wird das Original nicht überschrieben
VORLAGE = Laufwerksordner
Set worddoc = wordobj.Documents.Add(Template:=VORLAGE)
'Vorgeschlagener Ordner, wenn 'Speichern unter' in Word gewählt wird
'Ordner muss schon existieren.
'worddoc.Parent.ChangeFileOpenDirectory "e:\"
With wordobj
'Make the application visible.
wordobj.Visible = True
'wordobj.Activate
'Open the document.
'Move to each bookmark and insert text from the form.
'Fehlerroutine für nicht vorhandene bookmarks in Wordvorlage
On Error GoTo ERRORBEENDEN
Set rs = Me![frmArtikelOfferte].Form.RecordsetClone
rs.MoveLast
rs.MoveFirst
If Not (rs.EOF And rs.BOF) Then
For i = 1 To rs.RecordCount
'worddoc.Bookmarks("Pharmacode").Select
'wordobj.Selection.TypeText Text:=CStr(rs!PH_Code)
worddoc.Bookmarks("Bezeichnung").Select
wordobj.Selection.TypeText Text:=CStr(rs!Bezeichnung)
worddoc.Bookmarks("Generika").Select
wordobj.Selection.TypeText Text:=CStr(rs!Generika)
If i = rs.RecordCount Then Exit Sub 'Leerzeile vermeiden
wordobj.Selection.InsertRows 1
wordobj.Selection.Collapse Direction:=wdCollapseStart
'wordobj.Selection.MoveRight Unit:=wdCell
'With worddoc
'Set objBMRange = wordobj.Selection.Range
'.Bookmarks.Add Name:="Pharmacode", Range:=objBMRange
'.Bookmarks.DefaultSorting = wdSortByName
'.Bookmarks.ShowHidden = False
'End With
wordobj.Selection.MoveRight Unit:=wdCell
With worddoc
Set objBMRange = wordobj.Selection.Range
.Bookmarks.Add Name:="Bezeichnung", Range:=objBMRange
.Bookmarks.DefaultSorting = wdSortByName
.Bookmarks.ShowHidden = False
End With
wordobj.Selection.MoveRight Unit:=wdCell
With worddoc
Set objBMRange = wordobj.Selection.Range
.Bookmarks.Add Name:="Generika", Range:=objBMRange
.Bookmarks.DefaultSorting = wdSortByName
.Bookmarks.ShowHidden = False
End With
rs.MoveNext
Next i
End If
rs.Close
Set rs = Nothing
End With
Set worddoc = Nothing
Set wordobj = Nothing
Exit Sub
ERRORBEENDEN:
Exit Sub
End Sub
Private Sub DokumentFRZ_Enter()
Vorlagenordner = Application.CurrentProject.Path
Dim i As Integer
Dim Lesefiles As String
Dim test As Integer
Dim FS As FileSearch
Set FS = Application.FileSearch
With FS
.LookIn = Vorlagenordner
.NewSearch
.SearchSubFolders = False
'Filter für *.doc einstellen
.FileName = "*.doc*"
.Execute
For i = 1 To .FoundFiles.Count
Lesefiles = Lesefiles & ";" & Mid(.FoundFiles(i), Len(Vorlagenordner) + 2)
'Debug.Print Lesefiles
Next i
End With
'Me!comboVorlagenFRZ.RowSourceType = valuelist
Me!DokumentFRZ.RowSource = Mid(Lesefiles, 2)
End Sub
Hat einer einen Tipp
Gruß Edgar