ID tematu: 75347
|
Przenoszenie danych z tabeli Ms Access do tabeli Ms Word |
Autor |
Wiadomość |
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 09-12-2023, 09:11 Przenoszenie danych z tabeli Ms Access do tabeli Ms Word
|
|
|
Jak zmienić zapis żeby rekordy z tabeli tbl_Contacts były wybierane z pola listy w zależności od zaznaczenia a nie z pola kombi
Kod: | sDocFile = CurrentProject.Path & "\SomeWordDocument.docx"
Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID=" & Me.cbo_ContactName)
End Sub
Dim sDocFile As String
sDocFile = CurrentProject.Path & "\SomeWordDocument.docx"
Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID=" & Me.Lista17) |
mam taki błąd jak w załączniku
Zrzut ekranu 2023-12-09 090036.png
|
|
Plik ściągnięto 25 raz(y) 47.91 KB |
|
|
| ID posta:
432036
|
|
|
|
|
|
|
Tajan
Pomógł: 5530 razy Posty: 12010
|
Wysłany: 09-12-2023, 11:40
|
|
|
Na podstawie obrazka trudno określić przyczynę błędu. Tym bardziej, ze nie wiadomo czym jest "Lista17". Jeżeli to formant ActiveX to może należy sprawdzić czy coś zostało wybrane z listy. Coś takiego:
Kod: | If Me.Lista17.ListIndex > -1 Then
Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID=" & Me.Lista17.Value)
Else
MsgBox "Wybierz kontakt z listy"
End If
|
|
|
| ID posta:
432042
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 10-12-2023, 00:55
|
|
|
jeżeli ListBox ma własność Multiselect=0, wtedy można zrobic tak jak Tajan napisal.
Widzę jednak że masz multiselect=1 lub 2
więc nawet jak zrobisz jak Tajan radzi to błąd nadal będzie bo warunek listindex > -1 jest spełniony, a Lista17.Value wygeneruje błąd
więc teraz pytanie:
czy chcesz w zapytaniu porównać w klauzuli WHERE pierwszy zaznaczony ID ?
Kod: | Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID = " & Lista17.ItemData(Lista17.ItemsSelected(0))) |
czy wszystkie ?
Kod: |
Dim sIN As String
For Each i In Lista17.ItemsSelected
sIN = sIN & IIf(Len(sIN) > 0, ", ", "") & Lista17.ItemData(i)
Next
Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID IN (" & sIN & ")") |
|
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432048
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 10-12-2023, 13:00
|
|
|
Tajan jest tak jak master_mix napisał Lista17.Value wygenerowała błąd wcześniej podałem za mało informacji do pomocy ale dzięki za wpis.
master_mix chcę porównać w klauzuli WHERE wszystkie
kod działa doskonale zadeklarowałem tylko Dim i As Variant bo brakowało.
Teraz w moim projekcie zostały dwa tematy
1.formatowania tabeli np. format liczby walutowy nie przenoszą się formatowania z Access do Word dodatkowo pewne dane chcę pogrubić w Wordzie
2. umieszczenie tabeli w innym miejscu niż na pierwszej stronie dokumentu bo tak się obecnie dzieję.
może jakieś sugestie w tym temacie kod poniżej
Kod: | Function Export2DOC(sDocFile As String, sQuery As String)
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim iRecCount As Integer
Dim iFldCount As Integer
Dim i As Integer
Dim j As Integer
Const wdPrintView = 3
Const wdWord9TableBehavior = 1
Const wdAutoFitFixed = 0
Const xlLandscape = 2
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = True
Set oWordDoc = oWord.Documents.Open(sDocFile)
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
oWord.ActiveWindow.View.Type = wdPrintView 'Switch to print preview mode (not req'd just a personal preference)
oWordDoc.PageSetup.TogglePortrait 'Switch to landscape
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=iRecCount + 1, NumColumns:= _
iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set oWordTbl = oWordDoc.Tables(1)
'Build our Header Row
For i = 0 To iFldCount - 1
oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
Next i
'Build our data rows
For i = 1 To iRecCount
For j = 0 To iFldCount - 1
oWordTbl.Cell(i + 1, j + 1) = Nz(rs.Fields(j).Value, "")
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
' oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
' If bWordOpened = False Then
' oWord.Quit
' End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
|
|
|
| ID posta:
432052
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 10-12-2023, 22:47
|
|
|
nie bardzo wiem co masz na myśli że format walutowy się nie przenosi...
ale zawsze możesz sprawdzić jaki typ danych jest w konkretnym polu recordseta i sformatować po swojemu.
Czy tabelę chcesz wstawiać na nowej stronie dokumentu? bo też nie sprecyzowałeś.
Ale zakładam że otwierany dokument jest jakimś szablonem i chcesz wstawić na nowej stronie.
Kod: |
Function Export2DOC(sDocFile As String, sQuery As String)
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim iRecCount As Integer
Dim iFldCount As Integer
Dim i As Integer
Dim j As Integer
Const wdPrintView = 3
Const wdWord9TableBehavior = 1
Const wdAutoFitFixed = 0
Const xlLandscape = 2
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = True
Set oWordDoc = oWord.Documents.Open(sDocFile)
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
oWord.ActiveWindow.View.Type = wdPrintView 'Switch to print preview mode (not req'd just a personal preference)
oWordDoc.PageSetup.TogglePortrait 'Switch to landscape
Dim rngNewPage As Object
Set rngNewPage = oWordDoc.Content
rngNewPage.Start = oWordDoc.Content.End
rngNewPage.InsertBreak Type:=7
Set oWordTbl = oWord.ActiveDocument.Tables.Add(Range:=rngNewPage, NumRows:=iRecCount + 1, NumColumns:= _
iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed)
Dim wCell As Object
'Build our Header Row
For i = 0 To iFldCount - 1
oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
Next i
'Build our data rows
For i = 1 To iRecCount
For j = 0 To iFldCount - 1
Set wCell = oWordTbl.Cell(i + 1, j + 1)
If VarType(rs.Fields(j).Value) = vbCurrency Then
wCell.Range.Text = Format(Nz(rs.Fields(j).Value, ""), "$# ###.##") 'formatuj po swojemu
Else
wCell.Range.Text = Nz(rs.Fields(j).Value, "")
End If
If j = 3 Then 'TUTAJ WARUNEK KIEDY BOLD'OWAĆ
wCell.Range.Bold = True
End If
Next j
.MoveNext
Next i
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
'oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
'If bWordOpened = False Then
' oWord.Quit
'End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
|
|
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432067
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 12-12-2023, 20:43
|
|
|
Formatowanie działa świetnie dzięki master_mix
Pozostaje temat umieszczenia tabeli w odpowiednim miejscu nie na nowej stronie tylko w określonej linii paragrafie |
|
| ID posta:
432105
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 12-12-2023, 21:14
|
|
|
zamień to:
Kod: | Dim rngNewPage As Object
Set rngNewPage = oWordDoc.Content
rngNewPage.Start = oWordDoc.Content.End
rngNewPage.InsertBreak Type:=7
Set oWordTbl = oWord.ActiveDocument.Tables.Add(Range:=rngNewPage, NumRows:=iRecCount + 1, NumColumns:= _
iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed) |
na to (oczywiście wybierz odpowiedni paragraphs):
Kod: | Dim rngNewPage As Object
Set rngNewPage = oWordDoc.Paragraphs(1).Range
Set oWordTbl = oWord.ActiveDocument.Tables.Add(Range:=rngNewPage, NumRows:=iRecCount + 1, NumColumns:= _
iFldCount, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed) |
|
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432106
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 12-12-2023, 21:31
|
|
|
zmieniam oWordDoc.Paragraphs(1).Range na oWordDoc.Paragraphs(9).Range i jest błąd
Zrzut ekranu 2023-12-12 212928.png
|
|
Plik ściągnięto 3 raz(y) 15.22 KB |
|
|
| ID posta:
432107
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 12-12-2023, 21:49
|
|
|
Więc z tego wynika że paragraphs9 nie istnieje w dokumencie |
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432108
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 12-12-2023, 21:56
|
|
|
Tak masz rację dla testu wstawiłem w Wordzie 8 zamiast 9 jest ok. Wielkie dzięki |
|
| ID posta:
432109
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 16-12-2023, 07:43
|
|
|
Jednak muszę zmienić koncepcję ciężko jest wskazać miejsce tabeli w konkretnym paragrafie, ponieważ dane przed nim się zmieniają co przesuwa wskazany paragraf.
Chcę żeby tabela była zawsze pod punktem 7.1. Nazwa jest to stały tekst może macie jakieś rozwiązania |
|
| ID posta:
432199
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 17-12-2023, 01:14
|
|
|
trzecim argumentem jest szukany tekst
Kod: | Function Export2DOC(sDocFile As String, sQuery As String, findText As String)
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordTbl As Object
Dim bWordOpened As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim iRecCount As Integer
Dim iFldCount As Integer
Dim i As Integer
Dim j As Integer
Const wdPrintView = 3
Const wdWord9TableBehavior = 1
Const wdAutoFitFixed = 0
Const xlLandscape = 2
'Start Word
On Error Resume Next
Set oWord = GetObject("Word.Application") 'Bind to existing instance of Word
If Err.Number <> 0 Then 'Could not get instance of Word, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oWord = CreateObject("Word.application")
bWordOpened = False
Else 'Word was already running
bWordOpened = True
End If
On Error GoTo Error_Handler
oWord.Visible = True
Set oWordDoc = oWord.Documents.Open(sDocFile)
'Open our SQL Statement, Table, Query
Set db = CurrentDb
Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
With rs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
oWord.ActiveWindow.View.Type = wdPrintView 'Switch to print preview mode (not req'd just a personal preference)
oWordDoc.PageSetup.TogglePortrait 'Switch to landscape
Dim rngNewPage As Object
Set rngNewPage = oWordDoc.Content
rngNewPage.Find.Execute findText
If rngNewPage.Find.Found Then
rngNewPage.MoveEnd 3
rngNewPage.Start = rngNewPage.End
rngNewPage.InsertParagraphAfter
Set oWordTbl = oWord.ActiveDocument.Tables.Add(Range:=rngNewPage, NumRows:=iRecCount + 1, NumColumns:= _
iFldCount, DefaultTableBehavior:=1, AutoFitBehavior:=0)
Dim wCell As Object
'Build our Header Row
For i = 0 To iFldCount - 1
oWordTbl.Cell(1, i + 1) = rs.Fields(i).Name
Next i
'Build our data rows
For i = 1 To iRecCount
For j = 0 To iFldCount - 1
Set wCell = oWordTbl.Cell(i + 1, j + 1)
If VarType(rs.Fields(j).Value) = vbCurrency Then
wCell.Range.Text = Format(Nz(rs.Fields(j).Value, ""), "$# ###.##") 'formatuj po swojemu
Else
wCell.Range.Text = Nz(rs.Fields(j).Value, "")
End If
If j = 3 Then 'TUTAJ WARUNEK KIEDY BOLD'OWAĆ
wCell.Range.Bold = True
End If
Next j
.MoveNext
Next i
Else
MsgBox "text not found"
End If
Else
MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Word spreadsheet with"
GoTo Error_Handler_Exit
End If
End With
'oWordDoc.Close True, sFileName 'Save and close
'Close Word if is wasn't originally running
'If bWordOpened = False Then
' oWord.Quit
'End If
Error_Handler_Exit:
On Error Resume Next
oWord.Visible = True 'Make Word visible to the user
rs.Close
Set rs = Nothing
Set db = Nothing
Set oWordTbl = Nothing
Set oWordDoc = Nothing
Set oWord = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Export2DOC" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
|
|
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432209
|
|
|
|
|
|
sowa_222
Stały bywalec Excelforum
Wersja: Win Office 2010
Posty: 281
|
Wysłany: 17-12-2023, 09:09
|
|
|
jeszcze jest taki błąd
Zrzut ekranu 2023-12-17 090401.png
|
|
Plik ściągnięto 8 raz(y) 42.55 KB |
|
|
| ID posta:
432211
|
|
|
|
|
|
master_mix
Excel Expert
Wersja: Win Office 365
Pomógł: 1293 razy Posty: 2637
|
Wysłany: 17-12-2023, 10:19
|
|
|
No przecież żem pisał
master_mix napisał/a: | trzecim argumentem jest szukany tekst |
Kod: |
Call Export2DOC(sDocFile, "SELECT * FROM tbl_Contacts WHERE ID IN (" & sIN & ")", "7.1")
|
|
_________________
Podejmę współpracę (pracę)
Programowanie C#, Android, iOS, VB.NET, VBA, ASP.NET Core, WPF, Xamarin, Power Platforms, XAML, MVC, LINQ, Entity Framework. Bazy danych SQL Server, Oracle, MySQL, Firebird
Wrocław i okolice …lub zdalnie. |
|
| ID posta:
432212
|
|
|
|
|
|
|
Nie możesz pisać nowych tematów Nie możesz odpowiadać w tematach Nie możesz zmieniać swoich postów Nie możesz usuwać swoich postów Nie możesz głosować w ankietach Nie możesz załączać plików na tym forum Możesz ściągać załączniki na tym forum
|
Dodaj temat do Ulubionych Wersja do druku
|
|
Strona uĹźywa plikĂłw cookies.
Kliknij tutaj, Ĺźeby dowiedzieÄ siÄ jaki jest cel uĹźywania cookies oraz jak zmieniÄ ustawienia cookie w przeglďż˝darce.
KorzystajÄ
c ze strony uĹźytkownik wyraĹźa zgodÄ na uĹźywanie plikĂłw cookies, zgodnie z bieĹźÄ
cymi ustawieniami przeglÄ
darki.
SprawdĹş, w jaki sposĂłb przetwarzamy dane osobowe
|