Hej!

Jag skall bygga upp ett dokument med flera mallar och lägga in uppgifter i dem.
det lustiga är att det fungerar fint om jag gör Word synligt innan man lägger in data, men om man gör det synligt först efter så har tabellerna nästlat sig in i varandra.

Ett annat problem äe att om jag minimerar word innan jag gör det synligt får jag sedan bara upp ett dokumentfönster utan meny eller verktygsknappar. ngn som haft liknande problem eller.

Koden är:

<code>

Private Sub Command2_Click()
On Error Resume Next
Dim t1 As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim wrd As Word.Application
Set wrd = CreateObject("Word.Application")
wrd.Documents.Add
pg1.Max = ListView1.ListItems.Count * 2
Dim index As Integer, index2 As Integer, TextStorlek As Double, TextTyp As String, strText As String
cnn.CursorLocation = adUseClient
cnn.Open Db1.Conn1
t1.ActiveConnection = cnn
t1.Source = "SELECT * FROM Apqp006huvud WHERE Löpnr=" & Text1.Text
t1.CursorType = adOpenKeyset
t1.LockType = adLockReadOnly
t1.Open
wrd.Visible = True
wrd.WindowState = wdWindowStateMinimize

With wrd

'********** Huvuduppgifter *************************
.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=2, NumColumns:= _
4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
' Rad 1
.Selection.TypeText Text:="Nr: "
.Selection.MoveRight Unit:=wdCell
IIf Not IsNull(t1.Fields("Löpnr")) And t1.Fields("Löpnr") <> "", strText = t1.Fields("Löpnr"), strText = " "
.Selection.TypeText Text:=strText
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:="Ämne"
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:=t1.Fields("Ämne").Value
.Selection.MoveRight Unit:=wdCell
'Rad 2
.Selection.TypeText Text:="Ansv: "
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:=t1.Fields("Namn").Value
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:="Datum"
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:=t1.Fields("Datum").Value
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.TypeParagraph

.Selection.TypeText Text:="Anm:"
.Selection.TypeParagraph
.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
.Selection.TypeText Text:=t1.Fields("Kommentar").Value
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.TypeParagraph
'********** Slut på Huvuduppgifterna *************************

t1.Close
' ********** Distrubitionslista ***************
t1.Source = "SELECT * FROM apqp006distrlista WHERE Regnr=" & Text1.Text
t1.Open

.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=2, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
.Selection.TypeText Text:="Distrubitionslista"
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:="Info"
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:="Deltagare"
.Selection.MoveRight Unit:=wdCharacter, Count:=2
For index = 1 To t1.RecordCount
pg1.Value = pg1.Value + 0.3
.Selection.TypeText Text:=t1.Fields("Namn").Value
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:=IIf((t1.Fields("Info").Value = 1), t1.Fields("Info").Value, "")
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:=IIf((t1.Fields("Deltagare").Value = 1), t1.Fields("Deltagare").Value, "")
.Selection.MoveRight Unit:=wdCell
t1.MoveNext
Next index
t1.Close
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.TypeParagraph

' ********** Slut på distrubitionslista ***************


'************* Info **********************************

For index = 1 To ListView1.ListItems.Count
.ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
.Selection.Rows.AllowBreakAcrossPages = False

t1.Source = "SELECT * FROM apqp006 where Löpnr=" & ListView1.ListItems(index).Tag
t1.Open

pg1.Value = pg1.Value + index
TextTyp = .Selection.Font.Name
TextStorlek = .Selection.Font.Size
.Selection.MoveRight Unit:=wdCell
.Selection.MoveUp Unit:=wdLine, Count:=1
.Selection.Cells.Split NumRows:=1, NumColumns:=2, MergeBeforeSplit:=False
.Selection.Cells(1).PreferredWidthType = wdPreferredWidthPercent
.Selection.Cells(1).PreferredWidth = 70
.Selection.MoveLeft Unit:=wdCharacter, Count:=1
.Selection.Font.Bold = True
.Selection.Font.Underline = True
.Selection.TypeText Text:=t1.Fields("Rubrik").Value & vbCrLf
.Selection.Font.Bold = False
.Selection.Font.Underline = False
.Selection.TypeText Text:=t1.Fields("Anm").Value
.Selection.MoveRight Unit:=wdCell
.Selection.TypeText Text:="Ansvarig: " & t1.Fields("Namn") & vbCrLf & "Plan datum: " & t1.Fields("Planerad") & vbCrLf & "Klart: " & t1.Fields("Klar")
.Selection.MoveRight Unit:=wdCell
rtfText = t1.Fields("Kommentar")
Clipboard.Clear
Clipboard.SetText rtfText.TextRTF, vbCFRTF
.Selection.Paste
If index < ListView1.ListItems.Count Then .Selection.MoveRight Unit:=wdCell
.Selection.Font.Name = TextTyp
.Selection.Font.Size = TextStorlek
t1.Close
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.TypeParagraph

Next index
.Selection.MoveDown Unit:=wdLine, Count:=1
.Selection.HomeKey Unit:=wdStory
pg1.Value = pg1.Max - 1
.ActiveDocument.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPercent
.ActiveDocument.Tables(1).Columns(1).PreferredWidth = 8
.ActiveDocument.Tables(1).Columns(3).PreferredWidthType = wdPreferredWidthPercent
.ActiveDocument.Tables(1).Columns(3).PreferredWidth = 10

.ActiveDocument.Tables(3).PreferredWidthType = wdPreferredWidthPercent
.ActiveDocument.Tables(3).PreferredWidth = 80
.ActiveDocument.Tables(3).Columns(2).PreferredWidth = 40
.ActiveDocument.Tables(3).Columns(2).PreferredWidth = 20
.ActiveDocument.Tables(3).Columns(3).PreferredWidth = 20

End With
pg1.Value = pg1.Max
wrd.WindowState = wdWindowStateMaximize

'wrd.Visible = True
t1.Close
cnn.Close
Set t1 = Nothing
Set cnn = Nothing
Unload Me
End Sub


</code>

//Krister