02. april 2012 - 20:02Der er
6 kommentarer og 1 løsning
Hvordan hentes specifik data fra excel til word
Jeg har brug for jeres ekspert viden.
Overordnet set skal jeg lave et dokument hvor den selv henter priser fra excel. Der er jo den mulighed at linke til excel men problemet er at det er over 3000 emner:)
Word dokumentet består af en tabel med 5 kolonner med x antal rækker: |tekst | varenr | tekst |tekst |Pris | 1234 æble rød 1111 pære grøn
Tanken var at få flettet priserne ind på de rigtige steder ved at søge på 'varenr' i excel arket.
Rem Reference til Microsoft Excel er sat i VBA (Alt+F11/Tools/References/Microsoft Excel 12.0 Object Library Rem VBA-koden anbringes i VBA / ThisDocument Rem ======================================== Const stiTilPriser = "C:\Users\peter\Desktop\ChristianLeu\Priser.xls" '<-- ændres Const prisArkNavn = "InvenSalesPriceList" Dim xlsPriser
Dim antalTabeller As Integer, antalRækker As Integer Public Sub HentPriser() HouseKeeping
TraverserDokument
lukPriser MsgBox "Prissætning er afsluttet" End Sub Private Sub HouseKeeping() Set xlsPriser = CreateObject("Excel.Application") xlsPriser.Workbooks.Open stiTilPriser
antalTabeller = ActiveDocument.Tables.Count antalRækker = ActiveDocument.Tables(1).Rows.Count End Sub Private Sub TraverserDokument() Dim ræk, kolonne2, vareNr As Long, pris, p1, p2 Dim toPriser As Variant On Error GoTo fejl Application.ScreenUpdating = False
For ræk = 1 To antalRækker With ActiveDocument.Tables(1) kolonne2 = .Cell(ræk, 2) If Len(kolonne2) > 8 Then toPriser = Split(kolonne2, Chr(13)) p1 = toPriser(0) p2 = toPriser(1)
pris1 = findPris(p1) pris2 = findPris(p2) pris = Format(pris1, "###,###.00") & Chr(13) & Format(pris2, "###,###.00") .Cell(ræk, 5).Select Selection.Text = pris Else vareNr = Left(kolonne2, Len(kolonne2) - 2) 'blank + slutcelle fjernes pris = findPris(vareNr) .Cell(ræk, 5).Select Selection.Text = Format(pris, "###,###.00") End If End With Next ræk Exit Sub
fejl: MsgBox "Fejl erkendt i tabelrække: " & CStr(ræk) lukPriser End Sub Private Sub lukPriser() With xlsPriser .Application.Quit End With
Set xlsPriser = Nothing End Sub Private Function findPris(vareNr) Dim række As Long With xlsPriser.Range("A1:A65000") Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then række = c.Row Else række = 0 End If End With
If række <> 0 Then findPris = xlsPriser.Range("C" & række) Else findPris = 0 End If End Function
Ja - du følge blot det anført øverst: Rem Reference til Microsoft Excel er sat i VBA (Alt+F11/Tools/References/Microsoft Excel 12.0 Object Library)
Alle referencer er i alfabetisk orden - så du fjerner blot flueben for 12.0 - søg ned til Microsoft Excel 11.0 Object Library og sætter flueben i denne.
OK - gem og luk VBA-vinduet. Gem filen og start op igen..
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.