remcop1989
Gebruiker
- Lid geworden
- 29 mrt 2012
- Berichten
- 492
Vanuit een programma wordt een Word-document aangemaakt.
Zodra dit document aangemaakt wordt, controleert hij of de tekst "Deze offerte is gemaakt met behulp van Accountview." in het document staat. Wordt deze gevonden dan voert hij de volgende code uit:
Deze code zorgt ervoor dat er een mooie tabel wordt aangemaakt en bovendien de pagina die de tabel bevat in liggende afdrukstand wordt gezet.
Het probleem doet zich voor bij het printen: hij print de liggende pagina's niet liggend, maar staand uit, terwijl de tabel wel liggend (en dus onvolledig) erin staat.
Wie kan mij helpen naar de oplossing van het probleem?
Zodra dit document aangemaakt wordt, controleert hij of de tekst "Deze offerte is gemaakt met behulp van Accountview." in het document staat. Wordt deze gevonden dan voert hij de volgende code uit:
Code:
Sub checktext()
With ActiveDocument.Content.Find
.Text = "Deze offerte is gemaakt met behulp van Accountview."
.Forward = True
.Execute
If .Found = True Then FormatTableQuotationLines Else Exit Sub
End With
End Sub
Sub FormatTableQuotationLines()
Dim tbl As Table
Dim r As Integer
Dim c As Integer
Dim strVal1 As String
Dim strVal2 As String
Dim strVal3 As String
Dim strPrev As String
Dim WnWord As Object
If ActiveDocument.Tables.Count < 2 Then
' Verlaat macro er zijn geen tabellen beschikbaar.
Exit Sub
End If
' Ga de 2e tabel doorlopen.
Set tbl = ActiveDocument.Tables(2)
If tbl.Rows.Count > 0 Then
strVal1 = tbl.Cell(1, 1).Range.Text
strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
If Len(strVal1) = 0 Then
MsgBox "Formatering van offerteregels is reeds uitgevoerd."
Exit Sub
End If
End If
tbl.Select
Selection.InsertBreak wdSectionBreakContinuous
With Selection.Sections(1).PageSetup
.Orientation = wdOrientLandscape
End With
' Probeer de hele tabel landscape te tonen.
On Error Resume Next
Selection.InsertRowsAbove 1
For r = 1 To tbl.Rows.Count + 1
If r = 3 Then
' probeer een lege regel tussen te voegen
tbl.Cell(r, 1).Select
Selection.InsertRowsAbove 1
r = 4
End If
strVal1 = tbl.Cell(r, 1).Range.Text
' Verwijder regeleindes
strVal1 = Trim(Left(strVal1, Len(strVal1) - 2))
strVal2 = tbl.Cell(r, 2).Range.Text
' Verwijder regeleindes
strVal2 = Trim(Left(strVal2, Len(strVal2) - 2))
strVal3 = tbl.Cell(r, 3).Range.Text
' Verwijder regeleindes
strVal3 = Trim(Left(strVal3, Len(strVal3) - 2))
If strVal1 = Empty And strVal2 = Empty And strVal3 <> Empty Then
tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 2)
tbl.Cell(r, 1).Merge MergeTo:=tbl.Cell(r, 3)
If LCase(Left(tbl.Cell(r, 1).Range.Text, 6)) = "let op" Then
' Cursief weergeven en niet vet
tbl.Cell(r, 1).Range.Italic = True
tbl.Cell(r, 1).Range.Bold = False
Else
' Anders alleen vet formateren
tbl.Cell(r, 1).Range.Bold = True
End If
Else
End If
Next r
For c = 1 To tbl.Columns.Count
' Ga hier pas de 2e regel van lijnen voorzien van de tabel.
tbl.Cell(2, c).Select
With Selection.Cells
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
Next
' vergroot de tabelbreedte naar 25 centimeter
tbl.PreferredWidthType = wdPreferredWidthPoints
tbl.PreferredWidth = CentimetersToPoints(25)
' Probeer naar de laatste regel te gaan
tbl.Cell(r, 3).Select
' Ga daarna 1 regels lager staan
Selection.MoveDown Unit:=wdLine, Count:=10
' Zet de paginaindeling weer op portrait
Selection.InsertBreak Type:=wdSectionBreakContinuous
If Selection.PageSetup.Orientation = wdOrientPortrait Then
Selection.PageSetup.Orientation = wdOrientLandscape
Else
Selection.PageSetup.Orientation = wdOrientPortrait
End If
'Selection.HomeKey Unit:=wdStory
'Selection.MoveUp Unit:=wdScreen, Count:=40
'probeer het zoomniveau naar 100% en de focus naar het begin van het document te zetten
ActiveWindow.Caption = ActiveDocument.FullName
With ActiveWindow.View
'.Type = wdPrintPreview
.Zoom.Percentage = 100
End With
'probeer de focus naar het begin van het document te zetten
'roep de macro aan om de "zoektekst" te verwijderen
delete_text
' Roep na 5 seconden de functie Convert_2_PDF aan om direct een PDF aan te maken
' Application.OnTime when:=Now + TimeValue("00:00:06"), Name:="Convert_2_PDF"
End Sub
Sub delete_text()
'zoek de tekst "Deze offerte is gemaakt met behulp van Accountview." en verwijder deze
With Selection.Find
.ClearFormatting
.Text = "Deze offerte is gemaakt met behulp van Accountview."
.Wrap = wdFindContinue
.Execute
Selection.Delete
End With
End SubDeze code zorgt ervoor dat er een mooie tabel wordt aangemaakt en bovendien de pagina die de tabel bevat in liggende afdrukstand wordt gezet.
Het probleem doet zich voor bij het printen: hij print de liggende pagina's niet liggend, maar staand uit, terwijl de tabel wel liggend (en dus onvolledig) erin staat.
Wie kan mij helpen naar de oplossing van het probleem?
