• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel pagina naar Word pagina en opslaan

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.213
Beste,

Ik gebruik de volgende code om een excel pagina naar word te transporteren.
Dit lukt goed.
Enkel ik krijg het niet voor elkaar om ook nog de pagina instellingen mee nemen van mijn excel bla.
Ik kan ook de instellingen definiëren maar hoe kan ik dit doen.
Code: 
Sub KopieerenNaarExcel()
  Dim i As Integer
  Dim w As Object
  
' Om met Word te werken maken we een object (w) als Word-applicatie
    Set w = CreateObject("Word.Application")
' van blad 1 van het actieve workbook betrekken we de gegevens van de eerste rij
    With ActiveWorkbook.Sheets(1)
'   we openen een leeg document
      w.Documents.Add

'   we schrijven in het document een zinw.

      w.Visible = False
         Sheets("Bestellijst1").Range("E7:J7").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E8:J8").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E9:J9").Copy
         w.Selection.Paste
          
          With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With

      w.Selection.typetext Text:="Plaats Bedrijf"
      w.Selection.typetext Text:="Ref.  /bg" & vbCr & vbCr

            With w
            .Selection.Font.Name = "Verdana"
             .Selection.Font.Size = 14
               .Selection.Font.Bold = wdToggle
                 End With
        w.Selection.typetext Text:="Aanbieding" & vbCr
            With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With
      w.Selection.typetext Text:="Geachte ," & vbCr & vbCr
      w.Selection.typetext Text:="Naar aanleiding van uw offerte aanvraag bieden wij u onderstaand de volgende artikelen aan :" & vbCr & vbCr
      w.Selection.typetext Text:="Artikelnummer     Omschrijving                                                    Verpakt per     Prijs" & vbCr
    
    .Range("B19:W" & .Range("B19").End(xlDown).Row).Copy
       w.Selection.Paste
    
    End With
    
     w.Selection.typetext Text:="" & vbCr & vbCr
     w.Selection.typetext Text:="De levertijd is nader overeen te komen." & Chr(11) 'shift enter
     w.Selection.typetext Text:="De betaling dient na 21 dagen op ons rekeningnummer te zijn bijgeschreven." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Alle prijzen zijn geheel vrijblijvend en exclusief BTW en clichékosten." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Deze offerte is één maand geldig." & vbCr
     w.Selection.typetext Text:="Leveringen geschieden volgens ......., gedeponeerd bij de Kamer van Koophandel te Amsterdam." & vbCr
     w.Selection.typetext Text:="Wij menen u hiermee een gunstige aanbieding te hebben gedaan en zijn in afwachting van uw positieve reactie." & vbCr & vbCr
     
     w.Selection.typetext Text:="Hoogachtend," & vbCr
     w.Selection.typetext Text:="Bedrijfsnaam B.V" & vbCr & vbCr
     w.Selection.typetext Text:="Directeur" & vbCr
    
' het document wordt opgeslagen als
    w.ActiveDocument.SaveAs Filename:="P:\Offertes 2009\Opslag standaard Offerte\Standaard Offerte.doc"
    w.ActiveDocument.Close
 
End Sub
Ik heb dit maar weet het niet et plaatsen
Code: 
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(0.5)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(0.5)
        .RightMargin = CentimetersToPoints(0.5)
Groet HWV
 
en als je der dat van maakt ?
Code: 
With w
     .Selection.Orientation = wdOrientPortrait
       .Selection.TopMargin = CentimetersToPoints(0.5)
         .Selection.BottomMargin = CentimetersToPoints(1)
           .Selection.LeftMargin = CentimetersToPoints(0.5)
             .Selection.RightMargin = CentimetersToPoints(0.5)
                 End With
 
Bedankt voor de reactie`s,

Maar helaas nog niet gelukt
With ActiveDocument.PageSetup
Klik om te vergroten...
hij vraag dan om een end with.

Met de optie van Daniel zegt hij dat de Sub of functie niet is gedefinieerd.

Ik heb al op internet lopen zoek , maar zelf nog niks hierover tegen gekomen.
Met de help functie van excel ben ik ook niks tegen gekomen, ook al is het moeilijk zoeken als je niet hoe je iets moet omscrijven.

Groet HWV
 
Ik hoop dat je niet enkel die ene regel hebt willen invoegen maar
Code: 
With ActiveDocument.PageSetup 
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(0.5)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(0.5)
        .RightMargin = CentimetersToPoints(0.5)
End With
 
Ohké, ik dacht dat dit duidelijk zou zijn, foute aanname.
Elke with statement moet eindigen met een end with
Dat wordt dus zo.


Code: 
   With ActiveDocument.PageSetup
         .Orientation = wdOrientPortrait
         .TopMargin = CentimetersToPoints(0.5)
         .BottomMargin = CentimetersToPoints(1)
         .LeftMargin = CentimetersToPoints(0.5)
         .RightMargin = CentimetersToPoints(0.5)
    End With

mvg Leo
Edit, ik val in herhaling, trucker 10 was me voor zie ik nu...
 
Laatst bewerkt:
Bedankt voor de snelle reactie,
Daniel slaap jij niet ;-)

IK heb dit toe gevoegd zoals hierboven door jullie beiden aangegeven.
En toch krijg ik de foutmelding Sub of function is niet gedfinieerd.
En hij geef dit aan op
Code: 
.TopMargin = [COLOR="Red"]CentimetersToPoints[/COLOR](0.5)
In het engels al neer gezet maar maak niet uit.

Groet HWV
 
Haal boven in de vba de option explicit weg dan hoef je niet te definieren .
Ik heb deze nacht nog en paar posting gedaan tot rodn 03 uur , de afgelopen week was ik 24/24 in standby indien er chauffeurs camions of laadkleppen faalde en de tel staat dan niet stil :evil:
 
Haal boven in de vba de option explicit weg dan hoef je niet te definieren
Klik om te vergroten...

Daniel,

Deze staat niet in mijn VBA

Groet Henk
 
Probeer eens InchesToPoints ipv CentimetersToPoints
 
Zelfde fout melding

Ik heb nu de code alsvolgt, en krijg nog steeds dezelfde melding
Code: 
Sub KopieerenNaarExcel()
  Dim i As Integer
  Dim w As Object

' Om met Word te werken maken we een object (w) als Word-applicatie
    Set w = CreateObject("Word.Application")
' van blad 1 van het actieve workbook betrekken we de gegevens van de eerste rij
       With ActiveDocument.PageSetup
         .Orientation = wdOrientPortrait
         .TopMargin = InchesToPoints(0.5)
         .BottomMargin = InchesToPoints(1)
         .LeftMargin = InchesToPoints(0.5)
         .RightMargin = InchesToPoints(0.5)
    End With
    With ActiveWorkbook.Sheets(1).Columns("A:W")
    
'   we openen een leeg document
      w.Documents.Add
        
'   we schrijven in het document een zinw.

      w.Visible = False
         Sheets("Bestellijst1").Range("E7:J7").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E8:J8").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E9:J9").Copy
         w.Selection.Paste
          
          With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With

      w.Selection.typetext Text:="Plaats Bedrijf"
      w.Selection.typetext Text:="Ref.  /bg" & vbCr & vbCr

            With w
            .Selection.Font.Name = "Verdana"
             .Selection.Font.Size = 14
               .Selection.Font.Bold = wdToggle
                 End With
        w.Selection.typetext Text:="Aanbieding" & vbCr
            With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With
      w.Selection.typetext Text:="Geachte ," & vbCr & vbCr
      w.Selection.typetext Text:="Naar aanleiding van uw offerte aanvraag bieden wij u onderstaand de volgende artikelen aan :" & vbCr & vbCr
      w.Selection.typetext Text:="Artikelnummer     Omschrijving                                                    Verpakt per     Prijs" & vbCr
    
    .Range("B19:W" & .Range("B19").End(xlDown).Row).Copy
       w.Selection.Paste
    
    End With
    
     w.Selection.typetext Text:="" & vbCr & vbCr
     w.Selection.typetext Text:="De levertijd is nader overeen te komen." & Chr(11) 'shift enter
     w.Selection.typetext Text:="De betaling dient na 21 dagen op ons rekeningnummer te zijn bijgeschreven." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Alle prijzen zijn geheel vrijblijvend en exclusief BTW en clichékosten." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Deze offerte is één maand geldig." & vbCr
     w.Selection.typetext Text:="Leveringen geschieden volgens ......., gedeponeerd bij de Kamer van Koophandel te Amsterdam." & vbCr
     w.Selection.typetext Text:="Wij menen u hiermee een gunstige aanbieding te hebben gedaan en zijn in afwachting van uw positieve reactie." & vbCr & vbCr
     
     w.Selection.typetext Text:="Hoogachtend," & vbCr
     w.Selection.typetext Text:="Bedrijfsnaam B.V" & vbCr & vbCr
     w.Selection.typetext Text:="Directeur" & vbCr
    
' het document wordt opgeslagen als
    w.ActiveDocument.SaveAs Filename:="P:\Offertes 2009\Opslag standaard Offerte\Standaard Offerte.doc"
    w.ActiveDocument.Close
 
End Sub

Heb ik de code op een verkeerde plek staan ?

Groet Henk
 
Je moet de code wel zetten na documents.add
(en mogelijk deze eerst activeren)
Anders is er geen actief document.
 
Wanneer je het stukje code ooit hebt opgenomen met de macro recorder, kun je er ook vanuit gaan dat de centimerstopoints de juiste was, dat heeft nl met de land instellingen te maken.
Anders even experimenteren met beide.
 
blijven proberen
Code: 
 With w.Selection
         .Orientation = wdOrientPortrait
         .TopMargin = InchesToPoints(0.5)
         .BottomMargin = InchesToPoints(1)
         .LeftMargin = InchesToPoints(0.5)
         .RightMargin = InchesToPoints(0.5)
    End With
als ik in het eerst edel van je code kijk zie ik "Set w = CreateObject"
Code: 
Sub KopieerenNaarExcel()
  Dim i As Integer
  Dim w As Object

' Om met Word te werken maken we een object (w) als Word-applicatie
    Set w = CreateObject("Word.Application")

ook de sub titel kopieerenNaarExcel ?
 
Niet gelukt

Ik heb nu volgens mij van alles geprobeerd en kom er maar niet achter wat ik verkeerd doe.
Je moet nu twee talen door elkaar gaan schrijven excel en Word en dat gaat niet goed !
IK heb met behulp van SNB deze code gekregen en met diverse helpers gekregen zoals hij nu is.
Hij werkt maar doordat ik de bestellijst iets breder moest maken komen de lijnen niet goed over in de offerte.
In de word offerte heb ik nog marge over dus vandaar dat ik dit daar in mee wilde nemen.
Wat ik voorlopig ga aanhouden is met de hand de marge`s in het word document zetten, misschien met een nachtje slapen dat de ingeving er aan mijn kant gaat komen.


Groet Henk
 
Beste HWV , tijdens mijn ritje van daarjuist en het gezelschap van mijn laptop heb ik dit in elkaar hier kan je twee testjes doen , 1tje zonder opmaak en 1tje met opmaak in word . Ik hoop dat je hier wat aan hebt .
 

Bijlagen

Code: 
Sub KopieerenNaarExcel()
  Dim i As Integer
  Dim w As Object
  
' Om met Word te werken maken we een object (w) als Word-applicatie
    Set w = CreateObject("Word.Application")
' van blad 1 van het actieve workbook betrekken we de gegevens van de eerste rij
    With ActiveWorkbook.Sheets(1)
'   we openen een leeg document
      w.Documents.Add

'   we schrijven in het document een zinw.
        With w.ActiveDocument.PageSetup
            .Orientation = wdOrientPortrait
            .TopMargin = CentimetersToPoints(0.5)
            .BottomMargin = CentimetersToPoints(1)
            .LeftMargin = CentimetersToPoints(0.5)
            .RightMargin = CentimetersToPoints(0.5)
        End With
      w.Visible = False

Ook ZEER belangrijk is dat je voor je de code draait in VB-Editor >> Extra >> Verwijzingen >> Microsoft Word 10.0 Object Library aanvinkt (kan ook ander nummer zijn)
Bevestigen met OK
 
Sub of function is niet gedfinieerd

Code: 
Sub KopieerenNaarExcel()
  Dim i As Integer
  Dim w As Object
  
' Om met Word te werken maken we een object (w) als Word-applicatie
    Set w = CreateObject("Word.Application")
' van blad 1 van het actieve workbook betrekken we de gegevens van de eerste rij
    With ActiveWorkbook.Sheets(1)
'   we openen een leeg document
      w.Documents.Add

'   we schrijven in het document een zinw.
        With w.ActiveDocument.PageSetup
            .Orientation = wdOrientPortrait
            .TopMargin = [COLOR="Red"]CentimetersToPoints[/COLOR](0.5)
            .BottomMargin = CentimetersToPoints(1)
            .LeftMargin = CentimetersToPoints(0.5)
            .RightMargin = CentimetersToPoints(0.5)
        End With
        
'   we schrijven in het document een zinw.

      w.Visible = False
         Sheets("Bestellijst1").Range("E7:J7").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E8:J8").Copy
         w.Selection.Paste
         
         Sheets("Bestellijst1").Range("E9:J9").Copy
         w.Selection.Paste
          
          With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With

      w.Selection.typetext Text:="Plaats Bedrijf"
      w.Selection.typetext Text:="Ref.  /bg" & vbCr & vbCr

            With w
            .Selection.Font.Name = "Verdana"
             .Selection.Font.Size = 14
               .Selection.Font.Bold = wdToggle
                 End With
        w.Selection.typetext Text:="Aanbieding" & vbCr
            With w
            .Selection.Font.Name = "Verdana"
              .Selection.TypeParagraph
                .Selection.Font.Size = 10
                  .Selection.Font.Bold = wdToggle
                     End With
      w.Selection.typetext Text:="Geachte ," & vbCr & vbCr
      w.Selection.typetext Text:="Naar aanleiding van uw offerte aanvraag bieden wij u onderstaand de volgende artikelen aan :" & vbCr & vbCr
      w.Selection.typetext Text:="Artikelnummer     Omschrijving                                                    Verpakt per     Prijs" & vbCr
    
    .Range("B19:W" & .Range("B19").End(xlDown).Row).Copy
       w.Selection.Paste
    
    End With
    
     w.Selection.typetext Text:="" & vbCr & vbCr
     w.Selection.typetext Text:="De levertijd is nader overeen te komen." & Chr(11) 'shift enter
     w.Selection.typetext Text:="De betaling dient na 21 dagen op ons rekeningnummer te zijn bijgeschreven." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Alle prijzen zijn geheel vrijblijvend en exclusief BTW en clichékosten." & Chr(11) 'shift enter
     w.Selection.typetext Text:="Deze offerte is één maand geldig." & vbCr
     w.Selection.typetext Text:="Leveringen geschieden volgens ..........., gedeponeerd bij de Kamer van Koophandel te Amsterdam." & vbCr
     w.Selection.typetext Text:="Wij menen u hiermee een gunstige aanbieding te hebben gedaan en zijn in afwachting van uw positieve reactie." & vbCr & vbCr
     
     w.Selection.typetext Text:="Hoogachtend," & vbCr
     w.Selection.typetext Text:="Bedrijfsnaam B.V" & vbCr & vbCr
     w.Selection.typetext Text:="Directeur" & vbCr
    
' het document wordt opgeslagen als
    w.ActiveDocument.SaveAs Filename:="P:\Offertes 2009\Opslag standaard Offerte\Standaard Offerte.doc"
    w.ActiveDocument.Close
 
End Sub

Code aangepast zoals aangegeven en geef nog steeds dezelfde fout bij de rood gemaakte regel.

Ook ZEER belangrijk is dat je voor je de code draait in VB-Editor >> Extra >> Verwijzingen >> Microsoft Word 10.0 Object Library aanvinkt (kan ook ander nummer zijn)
Bevestigen met OK
Klik om te vergroten...
Deze staat bij mij nu aangevinkt, maar geef toch de fout Sub of function is niet gedfinieerd

groet Henk


PS,

Voor Daniel ( trucker 10 )
Ik heb deze beide geprobeerd maar krijg bij allebij de fout
ONTRBREEKT microsoft Word 12.0 object library
 
Laatst bewerkt:
HWV zei:
Code: 
PS,

Voor Daniel ( trucker 10 )
Ik heb deze bijde geprobeerd maar krijg bij allebij de fout
ONTRBREEKT microsoft Word 12.0 object library[/QUOTE]

Henk , ik heb dit gedaan in excel 2007 en word 2007 , doe dan wat Rudi zegt ga naar die instellingen in de editor .
Wat je eventueel ook kan doen , open een word document start de macro recorder , doe je opmaak in het word doc stop de recorder en kijk naar de code , > kuis eventueel op copy en paste in de excel macro .
Klik om te vergroten...
 
Henk, sluit Excel volledig af.
Heropen excel, open je bestand >> Alt-F11 >> Extra >> Verwijzingen >> Microsoft Word .... aanvinken >> Bevestigen met OK
Draai nu pas de macro
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan