Fra Excel til word template med VBA

Er det ikke bare almindelig brevfletning, du søger ?

Hej Finb

Du har helt ret.

Fandt dette fantastiske eksempel,
http://www.kronsell.net/BrevfletningExcelWord.htm

Men er det muligt at udvælge de felter der skal bruges vha filter, så kun de viste bliver nappet af scriptet eller?

Hej simon

Det er lidt siden, jeg har flettet, men:

JA, jeg mener du kan oprette en kolonnne med
fx krydser (x´er) og
i Excel flette-guiden kan du så udvælge
de rækker, hvor der er x,
eller fx de rækker, der er >5
eller indeholder *kat*
osv.osv.
Men jeg er ikke i top-flet-træning lige nu,
så se lige, om der melder sig flere svar.
finb

Hvis du anvender filter - så kan følgende måske anvendes:

        If Rows(ræk).Hidden = False Then
            ..... rækken er synlig ...
        End If

Jeg kæmper indimellem selv med brevfletning fra Excel. I den forbindelse stillede jeg et spørgsmål herinde:
http://www.eksperten.dk/spm/1003212

Et af svarene jeg endte med at bruge havde dette hint:

Det vil også være en mulighed at bygge en betingelse ind i feltkonstruktionen, så der ikke vises noget, hvis resultatet er "!Unexpected End of Formula". Det kan gøres som vist nedenfor - hvert sæt af feltklammer skal laves med Ctrl+F9 (kan ikke skrives med alm. tekst):

{ IF { =100*{ MERGEFIELD flettefelt } \# 0,0%} <> "!Unexpected End of Formula" { =100*{ MERGEFIELD flettefelt } \# 0,0%}}

Feltkoden betyder: Hvis resultatet af { =100*{ MERGEFIELD flettefelt } \# 0,0%} er forskelligt fra "!Unexpected End of Formula", så vis resultatet, ellers vis ingenting.

Om det er en brugbar løsning kommer an på, om en tom streng som resultat passer i den kontekst, feltet står i.

Blot for yderligere hint.
Jeg tænker ligesom finb at en klar/ikke-klar kolonne nok er vejen frem. Måske du ligefrem kan lave en form for seperat "fletteark/faneblad" hvor dataen kun dukker op hvis du har skrevet klar i en celle i dit oprindelige data. På den måde kan du brevflette forskelligt alt efter hvad der er klar.

Hej alle!

Mange tak for jeres kommentarer, der er lidt at gøre brug af :)

Jeg har dog problemer, jeg kan godt få den til at skrive til min word template med de rigtige oplysninger, men det er så også det.
Den kommer frem og siger at jeg har 7 filer (har indlagt en counter), men har kun én linje.

For at gøre det mere suspekt, så i stedet for bare at oprette og gemme dokumenterne, kommer den frem og spørger om jeg vil GEMME wordfilen under et HELT ANDET navn end jeg har tildelt den!

Hvad f... er der galt? Er helt rundtosset nu....

Her er koden:
[b]
Sub FletAC()
    Dim Wdapp As Object
    Dim Navn As String
    Dim Counter As Integer
   
    On Error Resume Next
    Set Wdapp = GetObject(, "Word.application")
    If Err.Number <> 0 Then
        Set Wdapp = CreateObject("Word.Application")
    End If
     
    For Each c In Range("B11:I140")
   
        Wdapp.Documents.Add "C:\Sti_til_template\template.dotx"
       
        If c.Value = "" Then
            Exit For
           
        Else
       
            Name = c.Value
           
            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDrawer"
           

            Wdapp.Selection.TypeText Text:=Range("B" & c.Row).Value
           
            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDrawing"
            Wdapp.Selection.TypeText Text:=Range("C" & c.Row).Text

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDrawingTitle"
            Wdapp.Selection.TypeText Text:=Range("D" & c.Row).Text

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACRev"
            Wdapp.Selection.TypeText Text:=Range("E" & c.Row).Text

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACChecker"
            Wdapp.Selection.TypeText Text:=Range("G" & c.Row).Value

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDate1"
            Wdapp.Selection.TypeText Text:=Range("H" & c.Row).Text

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDate2"
            Wdapp.Selection.TypeText Text:=Range("I" & c.Row).Text

            Wdapp.Selection.Goto What:=wdGoToBookmark, Name:="QAACDate3"
            Wdapp.Selection.TypeText Text:=Range("F" & c.Row).Text
                     
           
            Name = QAACDrawing & "_REV" & QAACRev
           
            Wdapp.ActiveDocument.SaveAs Filename:="C:\sti_til_dokumenter\" & Name & ".docx"

            Wdapp.ActiveDocument.Close
       
            Counter = Counter + 1
End If
    Next c

    MsgBox "Fletningen er færdig." & vbCrLf & Counter & " Dokumenter er blevet gemt.", _
        vbOKOnly + vbInformation

    Wdapp.Visible = False
   
    Wdapp.Quit

    Set Wdapp = Nothing
   
End Sub

[/B]

Hej Simon,

Har bare hurtigt skimmet koden igennem. Navn fejlen kommer umiddelbart pga  "Dim Navn As String" kontra "Name = QAACDrawing & "_REV" & QAACRev".

Det er lidt svært at justere din kode uden selv at have filen. Her er et eksempel på hvordan jeg plejer at sætte det op:

http://www.gratisupload.dk/f/8u4ekq1h1i/

Udpak filerne til "C:\Test" og så burde det virke. Så kan du selv sætte nogle hvis/if funktioner ind.

Hej VildeHest

Mange tak, men der er ingen kode i Excelarket.

Jeg kan godt se hvad du gør i din Wordfil, men jeg kan ikke kopiere det over i mit eget skema. Bruger du funktion "FIELDS" eller hvad gør du?

Jeg forestiller mig at i samme script som ovenstående, scanner den mappen for filer og tilføjer et "X" ud for samme fil i mit excelark.

Jeg har rettet navn/name fejlen uden held :) der bliver lavet én fil med navnet "_REV" selvom den siger at den har skrevet 16 filer..........

Jeg ville gerne dele filen, men må ikke grundet interne regler :)

Min fejl:

http://www.gratisupload.dk/f/8u6cpo1omi

Håber det hjælper. Jeg bruger "formfield"

Hej igen Vildehest

Det ser godt ud.

Jeg har problemer med Worddelen. Det du omtaler som "formfield", er det det samme som "forms"? Har du givet din formfield en grå baggrund? Jeg kan ikke selv oprette form fields magen til din, men kan copy/paste og så ændre i feltets indstillinger.

Jeg forstår ikke dete stykke:
Workbooks("Mappe1.xlsm").Sheets("Ark1").Range("a1").Select

Vil dit script kunne lave flere dokumenter eller skal jeg merge min første kode med din(som virker)? :)

Tak. Det er indsat som et tekstfelt. Du finder det under Udvikler>Ældre funktioner>Tekstfelt.

Workbooks("Mappe1.xlsm").Sheets("Ark1").Range("a1").Select

Dette er bare hvis du vil vælge hvilken celle der skal være aktiv bagefter. Kan sagtens slettes.

Hvad tænker du på ift. at lave flere dokumenter?

Mange tak! Har fundet det - havde ikke tænkt på at lede i den "gamle afdeling" :)

Mit ark er bygget op med flere rækker med data, som skal duplikeres over i en word template på bestemte pladser.
Hvis der er f.eks. 5 rækker skal der laves 5 dokumenter som det skal kopieres over i, er der kun én række skal der kun laves et dokument.

For info, hvis dokumentet gøres shared, så kommer den frem med fejl hvis man forsøger at skrive noget i en celle, hvor den fortæller at VB-koden ikke er kompatibel med min opsætning af Excel - det skal jeg nok lige have set nærmere på....

Dog har jeg foretaget følgende ændring:
Dim appWd As Word.Application ---> Dim appWd As Object

Det har sorteret de fleste fejlmeddelelser fra :)

http://gratisupload.dk/f/8u6xn2u759/

Det virker umiddelbart som du ønsker det. "lColumn = 20" Her indsætter du din sidste udfyldte kolonne.

Du kan givetvis også lave en loop function istedet for "on error". Så du ikke behøver skriver hver enkelt række ned. (Besværligt hvis du har mange).

Det er iøvrigt meget få VBA funktioner der virker i en shared excelfil, hvad jeg ved af. Så der er ikke så meget at se nærmere på.