Van Excel naar Word en PageSetup

Status
Niet open voor verdere reacties.
P

pruik

Gebruiker
Lid geworden
24 mrt 2008
Berichten
11
Beste mensen,

Ik wilde graag hulp bij het volgende probleem:

Ik wil graag een Wordbestand aanmaken vanuit Excel (dat lukt) en dit Wordbestand vervolgens opmaken: oriëntatie moet landscape worden.
Dat laatste lukt niet. En ook het zetten van de focus op het juiste document lukt me niet, zie de code.
Zover ben ik gekomen:

Code: 
Sub SvWrd(Fnaam)
Dim AppWord As Object
Set AppWord = CreateObject("Word.Application")

With AppWord
.Visible = True
.Application.Visible = True
.Documents.Add          'kan ik niet weglaten; geeft fout bij paste
End With

Range("A1:K26").Copy
AppWord.Selection.Paste
Application.CutCopyMode = False

'Gedeelte om het Wordbestand te besturen:
'waarom werkt dit niet?:
AppWord.ActiveDocument.PageSetup.Orientation = wdOrientLandscape
'AppWord.Documents.Item(1).PageSetup.Orientation = wdOrientLandscape  'werkt ook niet

AppWord.ActiveDocument.SaveAs Filename:=Fnaam & ".doc"    'werkt wél
'AppWord.documents.Open Filename:=Fnaam & ".doc"          'waarom zou dit moeten? is toch al open?

Application.ActivateMicrosoftApp xlMicrosoftWord        'om Word actief te maken; werkt

'focus zetten op het juiste document:
'AppWord.documents(Fnaam & ".doc").Activate  'doet niets
'AppWord.Documents.Item(1).Activate          'doet niets
'er zijn nu 2 documenten open: 1) met de naam uit Fnaam en 2) document2
'document2 heeft de focus


Set AppWord = Nothing
End Sub

Bij voorbaat vast bedankt voor de hulp.
 
Zorg dat Word al geladen is.
Draai dan de macro:

Code: 
Sub tst()
  With GetObject(, "Word.Application").Documents.Add
    Workbooks(1).Sheets(1).Range("A1:K26").Copy
    .Paragraphs(1).Range.Paste
    .PageSetup.Orientation = 1
    .SaveAs "naam.doc"
    .Application.Visible = True
    .Application.Activate
  End With
End Sub
 
Beste SNB,

heb 't meteen geprobeerd en 't werkte ook meteen
Dank, dank, en ook hulde, hulde.

Is het nu zo dat ná GetObject(, "Word.Application").Documents.Add de VBA-code bij Word geldig is?
M.a.w. waar had ik kunnen vinden dat het .PageSetup.Orientation = 1 moest zijn?

In ieder geval erg bedankt!
 
Is het nu zo dat ná GetObject(, "Word.Application").Documents.Add de VBA-code bij Word geldig is?
Klik om te vergroten...

Ja, voor alles dat gerelateerd is aan dit document: alles dat met een punt begint tussen With en End With.

M.a.w. waar had ik kunnen vinden dat het .PageSetup.Orientation = 1 moest zijn?
Klik om te vergroten...

Nergens zover ik weet. Ben er in het verleden zelf na 2 dagen deduceren wat wel en niet werkte, achtergekomen.
De 'integratie' van office-onderdelen beperkt zich blijkbaar tot het doorgeven van numerieke argumenten.
 
OK, dan ga ik een stapje verder:

Code: 
  With GetObject(, "Word.Application").Documents.Add
    Sheets(blad).Range("A1:M55").Copy
    .Paragraphs(1).Range.Paste
    .Tables(1).Select                     'dit werkt, in het doeldocument is de tabel geselecteerd
    .Selection.ClearFormatting       'dit werkt niet
    .Selection.Font.Size = 10         'dit ook niet
    .Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)     'dit ook niet
    .SaveAs Filename:=Fnaam & ".doc"
    .Application.Visible = True
    .Application.Activate
  End With

Dat begrijp ik niet.
Als ik in Word een macro opneem die dit moet doen, dan wordt de code (ik heb de tabel reeds geselecteerd):
Code: 
    Selection.ClearFormatting
    Selection.ClearFormatting
    Selection.Font.Size = 10
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

(vreemd genoeg staan sommige regels dubbel)

Deze code werkt niet in de VBA-code die vanuit Excel naar Word wordt gestuurd.

De reden waarom ik dit probeer is dat de tabel die in Word komt te staan alleen maar verborgen tekst bevat en andere ongerechtigheden. Ik hoopte met deze code de tabel te kunnen schoonmaken.
 
Vermijd select, selection en activate in VBA.
In sommige gevallen - jouw voorbeeld - werkt het niet.

Als je gebruik maakt van wdAutoFitContent als argument, doe je juist weer waarvan ik je had gezegd dat dat niet gaat: een niet-numeriek argument doorgeven.

Ik geloof weinig van de code die je zegt opgneomen te hebben: daar zitten teveel fouten in (die de macro-recorder uiteraard niet maakt). Clearfomatting is geen methode die van toepassing is op een tabel. De eigenschap font heeft alleen een range.

Mij ontgaat de zin om een Excel-gebied naar een Worddocument te kopiëren, dat daarna als tabel in Word volledig leeggemaakt wordt.

Code: 
With GetObject(, "Word.Application").Documents.Add
    Sheets(blad).Range("A1:M55").Copy
    .Paragraphs(1).Range.Paste
    With .Tables(1)
       .range.Font.Size = 10
       .AutoFitBehavior 1
    End With 
    .SaveAs Fnaam & ".doc"
    .Application.Visible = True
    .Application.Activate
  End With
 
Laatst bewerkt:
Dank je.
Ja dat klopt wat betreft wdAutoFitContent. stom, sorry.
En ik heb zojuist inderdaad ook de conclusie getrokken dat Select en Selection niet werken.
Overigens vond ik in de Help een opmerking over GetObject, waaruit zou moeten blijken dat je toegang krijgt tot de eigenschappen en methoden van het nieuwe object.

Het was verder niet mijn bedoeling om de tabel weer leeg te maken; ClearFormatting zou de opmaak moeten verwijderen.
Ik heb dat nu zo opgelost:

Code: 
    With .Content.Font
        .Name = "Arial"
        .Size = 10
        .Hidden = False
    End With

Nadat ik de tabel naar het doeldocument heb gekopieerd, zou ik naar de volgende bladzijde willen gaan.
De nieuwe pagina kan ik maken met:
Code: 
    With .Paragraphs(1).Range
        .InsertBreak Type:=2        'ik heb dit keer goed opgelet
    End With

Het klinkt misschien stom, maar ik weet niet hoe ik eerst naar het einde van de pagina moet in het doeldocument.
Mag ik daarvoor je hulp nog eens inroepen?
 
Code: 
With ............Add
   ----------
  .content.insertbreak
End with

Clearformatting werkt alleen bij zoeken en vervangen.
 
Laatst bewerkt:
.content.insertbreak werkt hetzelfde als .Paragraphs(1).Range.insertbreak.
Om een harde pagina in te voegen heb je de volgende code nodig, dacht ik:

Code: 
.Paragraphs(1).Range.insertbreak Type:= 2

Dat doet .content.insertbreak ook, maar ik moest er dit van maken om het te laten werken (zoals je ziet heb ik je opmerking ter harte genomen)
Code: 
 .content.insertbreak 2

Alleen geven deze codes enkel een harde return.
Als ik de regel 2x onder elkaar zet, werkt het wel.

De complete code is nu als volgt, en werkt zonder fouten (tot nu toe tenminste).
Met dank voor je hulp!!

Code: 
Public Function NrWord(blad)
    Dim AppWord As Object
    Set AppWord = CreateObject("Word.Application")
    tnaam = Sheets("Start").Range("D7") & _
    Sheets("Start").Range("D6") & " (rap" & Right(blad, 2) & ") " & Date
    Fnaam = ActiveWorkbook.Path & "\" & tnaam
    Application.ScreenUpdating = False

  With GetObject(, "Word.Application").documents.Add
  'pagina 3
    Sheets(blad).Range("T1:AA20").Copy
    .Paragraphs(1).Range.Paste
    
    With .Content.Font
        .Name = "Arial"
        .Size = 10
        .Hidden = False
    End With
    .Tables(1).AutoFitBehavior 2
    .Content.insertbreak 2
    .Content.insertbreak 2
    
    'pagina 2
    Sheets(blad).Range("H1:S37").Copy
    .Paragraphs(1).Range.Paste
    With .Content.Font
        .Name = "Arial"
        .Size = 10
        .Hidden = False
    End With
    .Tables(1).AutoFitBehavior 2
    .Content.insertbreak 2
    .Content.insertbreak 2     '    .Paragraphs(1).Range.insertbreak Type:=2 doet hetzelfde

    
    'pagina 1
    Sheets(blad).Range("A1:F55").Copy
    .Paragraphs(1).Range.Paste
    With .Content.Font
        .Name = "Arial"
        .Size = 10
        .Hidden = False
    End With
    .Tables(1).AutoFitBehavior 2


    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(Fnaam & ".doc") Then
            respons = MsgBox("Je hebt dit rapport vandaag al een keer gemaakt." & Chr(13) & _
                      "Naam: " & tnaam & Chr(13) & "Wil je het bestaande rapport overschrijven?", 36)
          Else
            respons = 6
        End If
    End With
    If respons = 6 Then
        .SaveAs Filename:=Fnaam & ".doc"
        .Application.Visible = True
        .Application.Activate
      Else
        .Application.Quit 0     '0 betekent: niet opslaan
    End If
  End With
  Set AppWord = Nothing
  Application.ScreenUpdating = True
End Function

Zoals je ziet maak ik 3 pagina's aan in omgekeerde volgorde (omdat de paginascheiding boven aan de pagina terecht komt).
AutoFitBehavior 2 betekent "aanpassen aan pagina".
 
Je gebruikt een function onjuist.
De akties die je uit laat voeren zijn Word-akties, geen berekeningen.
Ook aan een Sub kun je argumenten doorgeven (blad bijv.)

Er staan nog wat overbodigheden in je code.
Met een lus kun je een herhalende aktie eenvoudiger programmeren.
De harde paginascheiding heb ik nu anders opgelost.

Code: 
Sub NrWord(blad)
  Application.ScreenUpdating = False

  With GetObject(, "Word.Application").documents.Add
    For j = 1 To 3
      Sheets(blad).Range(Choose(j, "T1:AA20", "H1:S37", "A1:F55")).Copy
      .Paragraphs.first.Range.Paste
      .Tables(1).AutoFitBehavior 2
        If j < 3 Then
          .Content.InsertParagraphBefore
          .Paragraphs.first.Range.InsertBreak
          .Content.InsertParagraphBefore
        End If
    Next
    
    With .Content.Font
      .Name = "Arial"
      .Size = 10
      .Hidden = False
    End With
    
    With Sheets("Start")
      tnaam = .[D7] & .[D6] & " (rap" & Right(blad, 2) & ") " & Format(Date, "yyyymmdd")
     End With
     If Dir(ActiveWorkbook.Path & "\" & tnaam & ".doc") <> "" Then
        If MsgBox("Je hebt dit rapport vandaag al een keer gemaakt." & Chr(13) & "Naam: " & tnaam & Chr(13) & "Wil je het bestaande rapport overschrijven?", 36) = vbYes Then
           .SaveAs ActiveWorkbook.Path & "\" & tnaam & ".doc"
           .Application.Visible = True
           .Application.Activate
         Else
           .Application.Quit 0
         End If
      End If
    End With
  Application.ScreenUpdating = True
End Sub
 
Beste SNB,
heel mooi, die vereenvoudiging.
Het is inderdaad mijn zwakke punt; ik ben dan ook geen professioneel programmeur.
Ik neem het graag, en met dank, over.

Toch een paar punten:
Sub NrWord(blad)
Application.ScreenUpdating = False

With GetObject(, "Word.Application").documents.Add
Klik om te vergroten...
Je laat een deel van mijn code weg:
Code: 
    Dim AppWord As Object
    Set AppWord = CreateObject("Word.Application")
Bij mij werkte GetObject() dan niet meer.

Ik heb dat stukje zo opgelost:
Code: 
  Dim AppWord As Object
  Set AppWord = CreateObject("Word.Application")
  Application.ScreenUpdating = False
  With AppWord.documents.Add
Het gedeelte vanaf If Dir(ActiveWorkbook....... , waarbij gecontroleerd wordt of het bestand al bestaat, heb ik veranderd, omdat Word wordt afgesloten als het bestand NIET bestaat.
Ik vermoed dat je het niet compact genoeg zult vinden, omdat ik een aantal commando´s moet herhalen. Maar écht, ik verzin niets beters:
Code: 
     If Dir(ActiveWorkbook.Path & "\" & tnaam & ".doc") = "" Then   'rapport bestaat niet
        .SaveAs ActiveWorkbook.Path & "\" & tnaam & ".doc"
        .Application.Visible = True
        .Application.Activate
     Else
        If MsgBox("Je hebt dit rapport vandaag al een keer gemaakt." & Chr(13) & "Naam: " & tnaam & _
        Chr(13) & "Wil je het bestaande rapport overschrijven?", 36) = vbYes Then
            .SaveAs ActiveWorkbook.Path & "\" & tnaam & ".doc"
            .Application.Visible = True
            .Application.Activate
        Else
           .Application.Quit 0
        End If
     End If
 
einde

Met dank aan iedereen die heeft meegedacht, zet ik de vraag op opgelost
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan