08. juni 2011 - 18:31Der er
11 kommentarer og 1 løsning
Hjælp til at overfører data til Excel fra Word Via VBA
Hejsa,
Jeg har et word dokument som fungere som en serie nummer generator via VBA til noget gravering....og dette virker alt sammen fint nok, men kunne nu godt tænke mig at man på en eller anden måde kunne få disse data (numre) som den smider ned på word dokument til at blive smidt over i excel ark som en kopi af numre hvor man evt. kunne have et tids stempel på excel ark så man kan se hvilke numre som er graveret og hvornår.
Koden som jeg bruger ser sådan ud og aktiveres vha en knap.:
Sub SerieNr()
Open "e:\Gravering\SerieNr.txt" For Input As #1 Line Input #1, a$ Close #1 Ser = Val(a$) Ser = Ser + 18 Open "e:\Gravering\SerieNr.txt" For Output As #1 Print #1, Str(Ser) Close #1 End If
Open "e:\Gravering\Dato.txt" For Input As #2 Line Input #2, a$ Close #2 Dat = Val(a$) Dat = InputBox("Indsæt graverings dato", , Dat) If Dat = "" Then ' afbryder handling hvis der klikkes på cancel Else Open "e:\Gravering\Dato.txt" For Output As #2 Print #2, Str(Dat) Close #2 End If
On Error Resume Next
num = Ser
For Each aCell In ActiveDocument.Tables(1).Columns(1).Cells aCell.Range.Text = Format(Str(Dat), "000000") & " " &_ Format(Str(num), "00000") num = num + 1 Next aCell
End Sub
koden smides ned i en tabel med 1 kolone og 18 rækker, dvs at der laves 18 nye numre for hver gang med den dato som man vælger at skrive. Her kunne jeg godt tænke mig hvis man på en eller anden måde kunne få den til at huske valg af dato og nummer start og nummer slut og indsætte det i excel ark.
eks. :
koden aktiveres og serie nummer generes som sådan: 080611 (valg af dato) 080611-11220 frem til 080611-11237 (indsættes i celler på dokument)
disse data kunne jeg godt tænke mig kom over i excel f.eks data.xls ark1 celle A2 (dato) 080611 celle A3 (første serie nummer) 11220 Celle A4 (sidste serie nummer) 11237 Og Celle A1 bliver som et tidsstempel dato og tid for data i celler.
Evt. kunne man på en eller anden måde indsætte noget kode som læser data i dokument og smider derefter disse data over i excel i forbindelse med en print (udskriv) kode
Spørg endelig hvis der er noget der ikke forståes.
Teknologi, AI og forretning er i centrum på Computerworlds Cloud og AI Festival i København d. 18. og 19. september. Se hele programmet for den store konference om strategisk brug af Cloud og AI på: www.cloud-festival.dk
Hvis ja: (I givet fald kan filer tilsendes) --------------------------------
Rem Reference er sat til Microsoft Excel i Tools / References Const sti = "d:\Gravering\" Sub serieNr()
Open sti + "SerieNr.txt" For Input As #1 Line Input #1, a$ Close #1 ser = Val(a$) ser = ser + 18 Open sti & "SerieNr.txt" For Output As #1 Print #1, Str(ser) Close #1 ' End If
Open sti & "Dato.txt" For Input As #2 Line Input #2, a$ Close #2 dat = Val(a$) dat = InputBox("Indsæt graverings dato", , dat) If dat = "" Then ' afbryder handling hvis der klikkes på cancel Else Open sti & "Dato.txt" For Output As #2 Print #2, Str(dat) Close #2 End If
' On Error Resume Next
Num = ser
For Each aCell In ActiveDocument.Tables(1).Columns(1).Cells aCell.Range.Text = Format(Str(dat), "000000") & " " & _ Format(Str(Num), "00000") Num = Num + 1 Next aCell
graveringsLog dat, ser, Num - 1 End Sub Private Sub graveringsLog(dato, start, slut) Dim gLog As Object Set gLog = CreateObject("Excel.Application") With gLog .workbooks.Open sti + "graveringsLog.xlsx" .Range("A1") = Now .Range("A2") = dato .Range("A3") = start .Range("A4") = slut
Beklager jeg ikke har kunne svare noget før, men der kom lige en ferie ind imellem ;-)
Jo spørgsmålet er/var skam helt aktuelt.
Men har lige afprøvet din kode og den virker perfekt, dog ændrede jeg den lidt så det kom på ark som jeg ville have det. Men har nu indset at det måske kunne være smart at benytte den samme graveringsLog til alle de forskellige typer jeg laver.....så er der en mulighed for at man kan vælge precis hvilket Sheet i GraveringsLog den skal åbne??
Ja det var nu ment som et på forhånd tak for en evt. lille tilføjelse, som vel egentlig ikke er en udvidelse men snare en precision af hvad den skal åbne Applikationenen altså ;-)
Syns du da der er grund til at oprette nyt spm, for det???
Helt ok, jeg forklarede det måske heller ikke godt nok.
din kode er helt fin og virker fint med lidt rettelse, men jeg indså mens jeg afprøvede at jeg godt kunne tænke mig hvis man i koden kunne kalde et specifikt "sheet".
således at man f.eks kunne kalde graveringsLog.xlsx "type 1" frem
legede lige lidt med det selv, og kom frem til dette her, om det er den korrekte måde ved jeg ikke, men det virker
Rem Reference er sat til Microsoft Excel i Tools / References Const sti = "d:\Gravering\" Sub serieNr()
Open sti + "SerieNr.txt" For Input As #1 Line Input #1, a$ Close #1 ser = Val(a$) ser = ser + 18 Open sti & "SerieNr.txt" For Output As #1 Print #1, Str(ser) Close #1 ' End If
Open sti & "Dato.txt" For Input As #2 Line Input #2, a$ Close #2 dat = Val(a$) dat = InputBox("Indsæt graverings dato", , dat) If dat = "" Then ' afbryder handling hvis der klikkes på cancel Else Open sti & "Dato.txt" For Output As #2 Print #2, Str(dat) Close #2 End If
' On Error Resume Next
Num = ser
For Each aCell In ActiveDocument.Tables(1).Columns(1).Cells aCell.Range.Text = Format(Str(dat), "000000") & " " & _ Format(Str(Num), "00000") Num = Num + 1 Next aCell
graveringsLog dat, ser, Num - 1 End Sub
Private Sub graveringsLog(dato, start, slut) Dim gLog As Object Set gLog = CreateObject("Excel.Application") With gLog .workbooks.Open sti + "graveringsLog.xlsx" .Sheets("type3").Activate .Range("A2") = Now .Range("B2") = dato .Range("C2") = start .Range("D2") = slut
.activeworkbook.Save End With
gLog.Quit Set gLog = Nothing End Sub
Dog har jeg nogle gange bemærket at hvis man vil tjekke om der sker noget i excel så er filen låst i skrivebeskyttet tilstand, men det virker som om det er en kortvarig tilstand dvs efter 10-20 min så kan man pludselig godt åbne filen..... er det en fejl eller er det meget normalt??? Er der noget man kan gøre for at modvirke dette??
Ahhh, fandt lige ud af at der manglede reference til excel i Word, selv om jeg syns at have sat hak i den har jeg åbenbart ikke fået gemt den, men efter det var gjort så låser den ikke mere.
Jeg ændrede også lige sidste Private Sub sådanne her:
Private Sub graveringsLog(dato, start, slut) Dim gLog As Object Set gLog = CreateObject("Excel.Application") With gLog .workbooks.Open sti + "graveringsLog.xlsx" .Sheets("Type3").Activate
.Range("A65536").End(xlUp).Offset(1, 0).Value = Now .Range("B65536").End(xlUp).Offset(1, 0).Value = dato .Range("C65536").End(xlUp).Offset(1, 0).Value = start .Range("D65536").End(xlUp).Offset(1, 0).Value = slut
.activeworkbook.Save End With
gLog.Quit Set gLog = Nothing End Sub
Jeg har fået løst mit spm og du ledte mig rigtig hen af vejen med et fuldt ud brugbart kode til løsning så smid lige et svar....
Dog kunne jeg godt lige tænke mig om du kunne svare mig på et lille spørgsmål i forbindelse med din kode løsning..
Det er i den første kode Sub SerieNr()
der er der en linie lige før End Sub
graveringsLog dat, ser, Num - 1
hvad betyder lige det....er det en form for indlæsning inden private Sub???
Sidste spørgsmål er frivilligt at svare på ;-) men ville dog være rart for forståelsens skyld.
Super tak for svar, det er rart at få svar på så man ved det til en anden gang :-)
velfortjente point er tildelt. tak for hjælpen.
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.
