20. december 2003 - 01:31Der er
37 kommentarer og 1 løsning
Indsættes data i Word
Hej
Følgende lange VBA indsætter bookmarks i Word (til at danne en større mænde labels). Data indsættes fra linie 70. Koden fungerer perfekt. Jeg ville dog gerne om den kunne starte med at indsætte data fra linie 70 (herefter printe) siden line 71 (printe).... indtil der kommer en tom linie. Er der en der kan hjælpe med at ændre koden?
vh Steen
Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Object Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String Dim sPath As String
'Og tildeler dem en værdi baseret på indholdet af arket With ActiveWorkbook.Sheets("Ark1") HCV = Range("I70").Value FNavn = Range("B70").Value ENavn = Range("E70").Value CPR = Range("G70").Value Adr = Range("AA70").Value PostBy = Range("AC70").Value End With
If Range("I70").Value <> "" Then
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") End If
'Så laver vi et nyt tomt dokument baseret på den relevante skabelon Wdapp.Documents.Add ("\\hjertesrv\faelles\Index\dokumenter\Sekretariat\Labels\Labels1.dot")
Med version 7 af TeamShare tager Lector næste skridt og bygger en platform for AI-agenter, der i højere grad kan følge medarbejderen gennem hele arbejdsprocessen.
Slettet bruger
20. december 2003 - 19:54#1
I en af kommentarene står der: 'Så gør vi Word synlig så der kan skrives i kontinuationen
Ja - der skal skrives en personspecifikt nr, Navn, Adresse og postnr og by på ca 60 stk labels. Men jeg har just fået løst problemet vha jKrons og udgiver snarligt løsningen. Tak for din interesse.
Synes godt om
Slettet bruger
20. december 2003 - 21:09#3
Du får også min løsning, da jeg alligevel har lavet den.
----------------------------
Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Word.Application Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String
Dim startRow As Integer Dim rowCounter As Integer
' Husk at sætte en reference til Word Objektet i menuen Tools -> References Dim WDoc As Word.Document Dim gemmeSti As String Dim filNavn As String
gemmeSti = "F:\" filNavn = "test.dot"
startRow = 70 rowCounter = startRow
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") End If
HCV = ActiveSheet.Cells(rowCounter, 9) Do 'Læs en række With ActiveSheet HCV = .Cells(rowCounter, 9) FNavn = .Cells(rowCounter, 2) ENavn = .Cells(rowCounter, 5) CPR = .Cells(rowCounter, 7) Adr = .Cells(rowCounter, 27) PostBy = .Cells(rowCounter, 29) End With rowCounter = rowCounter + 1
'Opret et nyt Word dokument baseret på skabelonen Wdapp.Documents.Add Template:=gemmeSti & filNavn, NewTemplate:=False, DocumentType:=0
With Wdapp.ActiveDocument 'Indsæt data i dokumentets bookmarks .bookmarks("Cpr").Range.Text = CPR .bookmarks("Hcv").Range.Text = HCV .bookmarks("FNavn").Range.Text = FNavn .bookmarks("ENavn").Range.Text = ENavn .bookmarks("Adr").Range.Text = Adr .bookmarks("PostBy").Range.Text = PostBy
'Gem dokumentet med CPR-nr som filnavn .SaveAs Filename:=gemmeSti & CPR & ".doc" .Close False End With
HCV = ActiveSheet.Cells(rowCounter, 9) Loop While HCV <> ""
'Så gør vi Word synlig så der kan skrives i kontinuationen Wdapp.Visible = True
'Og frigiver lidt hukommelse når Word lukkes Set Wdapp = Nothing
Jeg skal i løbet af aftenen / natten prøve at tilvirke den min projektmappe - Lige et par kommentarer:
Skabelonen der anvendes fremgår af vba fra første indlæg og den indeholder alle de bookmarks der fremgår deraf (bookmarks kan jo desværre kun anvendes én gang). Det er ikke nødvendigt at gemme dokumentet - det skal blot udprintes (og helst uden at se word poppe up).
Synes godt om
Slettet bruger
20. december 2003 - 22:10#8
Jeg skal lige se om jeg har forstået :-)
1. Dit nuværende dokument indeholder 55-60 labels 2. Der skal f.eks. indsættes 60 efternavne, men kun 5 adresser ? 3. Der skal altid printes samme antal labels ? 4. Min løsning er baseret på én skabelon der indeholder 1 label og printes X antal gange. Dit dokument er én skabelon der printes 1 gang og indeholder 55-60 labels.
Ja stort set rigtigt: 13 labels nedaf 5 heraf ialt 65 (hvoraf 12. række kun indeholder uvedkommende data) = 60 labels. Der er kun 5 med adressefelter anbragt i nederste (13.række) = 5 labels.
Synes godt om
Slettet bruger
20. december 2003 - 22:20#10
Ok, så er jeg vistnok med.
Dvs. der printes 60 labels med samme patientdata. Dvs. ét sæt labels (60 styk) pr. linie i Excel arket. ?
Synes godt om
Slettet bruger
20. december 2003 - 23:25#11
Hvis det er tilfældet, skal du nok bruge denne her istedet for.
-------------------------------- Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Word.Application Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String
Dim startRow As Integer Dim rowCounter As Integer Dim i As Integer
' Husk at sætte en reference til Word Objektet i menuen Tools -> References Dim WDoc As Word.Document Dim gemmeSti As String Dim filNavn As String Dim bm As String
gemmeSti = "F:\" filNavn = "test.dot"
startRow = 70 rowCounter = startRow
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") Wdapp.Visible = True End If
HCV = ActiveSheet.Cells(rowCounter, 9) Do 'Læs en række With ActiveSheet HCV = .Cells(rowCounter, 9) FNavn = .Cells(rowCounter, 2) ENavn = .Cells(rowCounter, 5) CPR = .Cells(rowCounter, 7) Adr = .Cells(rowCounter, 27) PostBy = .Cells(rowCounter, 29) End With rowCounter = rowCounter + 1
'Opret et nyt Word dokument baseret på skabelonen Wdapp.Documents.Add Template:=gemmeSti & filNavn, NewTemplate:=False, DocumentType:=0
With Wdapp.ActiveDocument 'Indsæt data i dokumentets bookmarks For i = 1 To 55 .bookmarks("Cpr" & i).Range.Text = CPR .bookmarks("Hcv" & i).Range.Text = HCV Next i
For i = 1 To 60 .bookmarks("FNavn" & i).Range.Text = FNavn .bookmarks("ENavn" & i).Range.Text = ENavn Next i
For i = 1 To 5 .bookmarks("Adr" & i).Range.Text = Adr .bookmarks("PostBy" & i).Range.Text = PostBy Next i End With
With Wdapp .PrintOut .ActiveDocument.Close False End With
HCV = ActiveSheet.Cells(rowCounter, 9) Loop While HCV <> ""
'Og frigiver lidt hukommelse når Word lukkes Set Wdapp = Nothing
End Sub ------------------------------------------
Synes godt om
Slettet bruger
20. december 2003 - 23:27#12
...Den printer et ark med 60 labels, for hver linie patientdata i Excelarket.
Den udprinter ark med 65 labels (med mindre ændringer). Jeg synes at det er en flot gang programmering du har lavet og det fungerer godt. Kan du også undgå at word popper up og at word lukkes automatisk - så er den ved at være der ;0)
Synes godt om
Slettet bruger
21. december 2003 - 00:58#14
Du skal ændre
Wdapp.Visible = True til Wdapp.Visible = False
og indsætte
Application.Quit efter Set Wdapp = Nothing
Synes godt om
Slettet bruger
21. december 2003 - 01:01#15
Du får lige det hele igen, med rettelser
---------------------
Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Word.Application Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String
Dim startRow As Integer Dim rowCounter As Integer Dim i As Integer
' Husk at sætte en reference til Word Objektet i menuen Tools -> References Dim WDoc As Word.Document Dim gemmeSti As String Dim filNavn As String Dim bm As String
gemmeSti = "F:\" filNavn = "test.dot"
startRow = 70 rowCounter = startRow
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") Wdapp.Visible = False End If
HCV = ActiveSheet.Cells(rowCounter, 9) Do 'Læs en række With ActiveSheet HCV = .Cells(rowCounter, 9) FNavn = .Cells(rowCounter, 2) ENavn = .Cells(rowCounter, 5) CPR = .Cells(rowCounter, 7) Adr = .Cells(rowCounter, 27) PostBy = .Cells(rowCounter, 29) End With rowCounter = rowCounter + 1
'Opret et nyt Word dokument baseret på skabelonen Wdapp.Documents.Add Template:=gemmeSti & filNavn, NewTemplate:=False, DocumentType:=0
With Wdapp.ActiveDocument 'Indsæt data i dokumentets bookmarks For i = 1 To 55 .bookmarks("Cpr" & i).Range.Text = CPR .bookmarks("Hcv" & i).Range.Text = HCV Next i
For i = 1 To 60 .bookmarks("FNavn" & i).Range.Text = FNavn .bookmarks("ENavn" & i).Range.Text = ENavn Next i
For i = 1 To 5 .bookmarks("Adr" & i).Range.Text = Adr .bookmarks("PostBy" & i).Range.Text = PostBy Next i End With
With Wdapp .PrintOut .ActiveDocument.Close False .Quit End With
HCV = ActiveSheet.Cells(rowCounter, 9) Loop While HCV <> ""
'Og frigiver lidt hukommelse når Word lukkes Set Wdapp = Nothing
End Sub
---------------------
Synes godt om
Slettet bruger
21. december 2003 - 01:04#16
Den eneste gang du kan risikere at se Word "poppe op" er hvis Word kører i forvejen. Det er dog nok bedst at sørge for at Word ikke kører, da det ellers kan konflikte med dokumenter som du tilfældigvis måtte have åben i forvejen.
Jeg påtænkte at indsætte nedenstående kode men ville gerne om der stod hvor mange dokumenter brugeren har valgt at udprinte (for at forhindre et større antal ved fejltryk) - kan du ændre den? Dim Msg, Style, Title, Ctxt, Response, MyString Msg = "Ønsker du at printe labels på X antal patienter?" ' Define message. Style = vbYesNo + vbDefaultButton2 ' Define buttons. Title = "Meddelelsesbox" ' Define title. Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then
Synes godt om
Slettet bruger
21. december 2003 - 01:08#18
Den burde muligvis bruge FNavn eller ENavn i løkken, da den ellers ville stoppe i utide. Der er jo 60 navne og kun 55 HCV numre.
Den har iøvrigt et andet irriterende problem. Word fremkommer med en advarsel om at printerområdet er uden for printerens margin - kan det undgåes - jeg har forsøgt Application.displayAlert uden held.
Den skriver: You Cannot close Microsoft Word because dialog is active
Synes godt om
Slettet bruger
21. december 2003 - 01:17#22
Meddelelsesboxen kræver at man laver en optælling af rækkerne inden udskrivningen sættes igang. Skal brugeren markere rækkerne i Excel arket inden der printes, eller skal den bare selv stoppe nå den løber tør for rækker ?
Den antager at data starter fra og med række 70.
Grunden til at jeg spurgte om FNavn i løkken er at den kan risikere at stoppe hvis f.eks. HCV er tom selvom der er data i FNavn.
Det kan med garanti ikke ske - den får sine data fra en database og der er præcist lige mange hcv og navne. Nej jeg ønsker ikke at brugerne skal markere rækkerne (faktisk er de uden for synsfeltet). Men jeg vil gerne forhindre at man ved en fejltastning kommer til at printe et større antal (det gjorde jeg selv ved en fejl)
Synes godt om
Slettet bruger
21. december 2003 - 01:33#24
Ok, prøv med denne her. -----------
Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Word.Application Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String
Dim startRow As Integer Dim rowCounter As Integer Dim maxRows As Integer Dim i As Integer
' Husk at sætte en reference til Word Objektet i menuen Tools -> References Dim WDoc As Word.Document Dim gemmeSti As String Dim filNavn As String Dim bm As String
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") Wdapp.Visible = False End If
HCV = ActiveSheet.Cells(rowCounter, 9) Do 'Læs en række With ActiveSheet HCV = .Cells(rowCounter, 9) FNavn = .Cells(rowCounter, 2) ENavn = .Cells(rowCounter, 5) CPR = .Cells(rowCounter, 7) Adr = .Cells(rowCounter, 27) PostBy = .Cells(rowCounter, 29) End With rowCounter = rowCounter + 1
'Opret et nyt Word dokument baseret på skabelonen Wdapp.Documents.Add Template:=gemmeSti & filNavn, NewTemplate:=False, DocumentType:=0
With Wdapp.ActiveDocument 'Indsæt data i dokumentets bookmarks For i = 1 To 55 .bookmarks("Cpr" & i).Range.Text = CPR .bookmarks("Hcv" & i).Range.Text = HCV Next i
For i = 1 To 60 .bookmarks("FNavn" & i).Range.Text = FNavn .bookmarks("ENavn" & i).Range.Text = ENavn Next i
For i = 1 To 5 .bookmarks("Adr" & i).Range.Text = Adr .bookmarks("PostBy" & i).Range.Text = PostBy Next i End With
With Wdapp .PrintOut .ActiveDocument.Close False .Quit End With
HCV = ActiveSheet.Cells(rowCounter, 9) Loop While HCV <> ""
Else 'Brugeren vil ikke udskrive rækkerne GoTo LukOgSluk End If
LukOgSluk: 'Og frigiver lidt hukommelse når Word lukkes Set Wdapp = Nothing
End Sub
Function confirm(antal As Integer) As Boolean Msg = "Ønsker du at printe labels på " & antal & " antal patienter?" ' Define message. Style = vbYesNo + vbDefaultButton2 ' Define buttons. Title = "Bekræft udskrivning af labels" ' Define title. Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then confirm = True Else confirm = False End If End Function
-------------
Synes godt om
Slettet bruger
21. december 2003 - 01:43#25
Har lige opdaget en fejl...
.Quit skal fjernes fra
With Wdapp .PrintOut .ActiveDocument.Close False .Quit End With
og indsættes her..
LukOgSluk: 'Og frigiver lidt hukommelse når Word lukkes Wdapp.Quit Set Wdapp = Nothing
Den giver sig aldrig til at printe. I stedet viser den en dialog-box? med meddelelsen: Please wait while Word finishes all pending print jobs (med mulighed for cancel)
Synes godt om
Slettet bruger
21. december 2003 - 01:54#28
Prøv at tilføje: Background:=True
efter
PrintOut
Synes godt om
Slettet bruger
21. december 2003 - 01:55#29
Du får lige en kodeopdatering
---------------------
Sub StartLabels()
'Vi erklærer lige nogen variable Dim Wdapp As Word.Application Dim HCV As String Dim CPR As String Dim FNavn As String Dim ENavn As String Dim Adr As String Dim PostBy As String
Dim startRow As Integer Dim rowCounter As Integer Dim maxRows As Integer Dim i As Integer
' Husk at sætte en reference til Word Objektet i menuen Tools -> References Dim WDoc As Word.Document Dim gemmeSti As String Dim filNavn As String Dim bm As String
'Undersøger om Word er startet On Error Resume Next Set Wdapp = GetObject(, "Word.application") If Err.Number <> 0 Then 'Ellers starter vi word Set Wdapp = CreateObject("Word.Application") Wdapp.Visible = False End If
Wdapp.DisplayAlerts = wdAlertsNone
HCV = ActiveSheet.Cells(rowCounter, 9) Do 'Læs en række With ActiveSheet HCV = .Cells(rowCounter, 9) FNavn = .Cells(rowCounter, 2) ENavn = .Cells(rowCounter, 5) CPR = .Cells(rowCounter, 7) Adr = .Cells(rowCounter, 27) PostBy = .Cells(rowCounter, 29) End With rowCounter = rowCounter + 1
'Opret et nyt Word dokument baseret på skabelonen Wdapp.Documents.Add Template:=gemmeSti & filNavn, NewTemplate:=False, DocumentType:=0
With Wdapp.ActiveDocument 'Indsæt data i dokumentets bookmarks For i = 1 To 55 .bookmarks("Cpr" & i).Range.Text = CPR .bookmarks("Hcv" & i).Range.Text = HCV Next i
For i = 1 To 60 .bookmarks("FNavn" & i).Range.Text = FNavn .bookmarks("ENavn" & i).Range.Text = ENavn Next i
For i = 1 To 5 .bookmarks("Adr" & i).Range.Text = Adr .bookmarks("PostBy" & i).Range.Text = PostBy Next i End With
With Wdapp .PrintOut Background:=True .ActiveDocument.Close False End With
HCV = ActiveSheet.Cells(rowCounter, 9) Loop While HCV <> ""
Else 'Brugeren vil ikke udskrive rækkerne GoTo LukOgSluk End If
LukOgSluk: 'Og frigiver lidt hukommelse når Word lukkes Wdapp.Quit Set Wdapp = Nothing Wdapp.DisplayAlerts = wdAlertsAll End Sub
Nu ser det bare kanongodt ud - desværre fortsat med det med printermargin (x 1 pr patient). Jeg har også prøvet at indsætte application.displayalert i worddokumentet uden resultat. Nu skal vi jo ikke glemme point - dem har du da slidt for :0)
Synes godt om
Slettet bruger
21. december 2003 - 02:33#36
Der er forskel på Application.DisplayAlerts = False
...som refererer til Excel programmet og
Wdapp.DisplayAlerts = wdAlertsNone
...som refererer til Word programmet.
Mht. printermargin kan du prøve (Husk at gemme en kopi af dokumentet inden du ændrer noget) at sætte skabelonens marginer til 0.
Eller du kan prøve at tilføje: ActiveDocument.FitToPages
således...
With Wdapp .ActiveDocument.FitToPages .PrintOut Background:=True .ActiveDocument.Close False End With
Begge forslag er dog uden garanti, da jeg ikke selv har brugt funktionerne før.
Hmm - det med FittoPages fungerede tilsyneladende - så er det blot at håbe at teksten havner inden for labels rammer (jeg har desværre ingen herhjemme). Tusinde tak for hjælpen - den har været forrygende. Kan du ha' en rigtig god jul :0)
Synes godt om
Slettet bruger
21. december 2003 - 02:45#38
Tak for point, god jul og godnat :-)
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
