Zbysek018 napsal/a:
Palooo: ....
prilozte ukazkovu prilohu skusim to urobit s vasim sposobom :) .... skusali ste aj For each pre kazdy OleObject ??? ked neviete nazovcitovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Import z Wordu do Excelu ve VBA Excel
prilozte ukazkovu prilohu skusim to urobit s vasim sposobom :) .... skusali ste aj For each pre kazdy OleObject ??? ked neviete nazovcitovat
MS Excel
Téma: Import z Wordu do Excelu ve VBA Excel 
Zaslal/a 25.2.2014 12:35
Zdravím,
prosím o radu ohledně importu doc (případně docx, rtf) souboru do excelu. Potřeboval bych ve VBA v excelu vytvořit makro po jehož spuštění by se mi do excelu na daný list a buňku zkopíroval kompletní obsah nějakého word dokumentu.
To se mi podařilo vytvořit přes OleObjects, jenže v tom případě mi to z nějakého důvodu načte vždy pouze první stránku Word dokumentu a ostatní nenačte. Nevím kde je problém. Možná se na to OleObject moc nehodí a lze to udělat nějak jednoduše.
Pro mě by bylo nejlepší asi vyloženě funkce Copy, než importovat soubor.
Nyní mám kód zadán takto:
Sub DL1_import()
'
' DL1_import Makro
' Import VV do části dodacího listu DL1
'
'
Sheets("DL1").Select
Range("A17").Select
ActiveSheet.OLEObjects.Add(Filename:= _
Worksheets("DL DATA").Range("b3").Text _
, Link:=False, DisplayAsIcon:= _
False).Select
Sheets("DL2").Select
Range("B3").Select
ActiveSheet.OLEObjects.Add(Filename:= _
Worksheets("DL DATA").Range("b4").Text _
, Link:=False, DisplayAsIcon:= _
False).Select
Sheets("DODACÍ LIST").Select
End Sub
Tedy reálně si to načtě jeden dokument na list DL1, druhý na list DL2, ale právě že to v obou případech načte pouze vždy první stránku.
Díky za rady
Strana: « předchozí 1
2
prilozte ukazkovu prilohu skusim to urobit s vasim sposobom :) .... skusali ste aj For each pre kazdy OleObject ??? ked neviete nazovcitovat
Palooo: přikládám
Příloha: 
18055_dl_test.zip (212kB, staženo 37x)
citovat18055_dl_test.zip (212kB, staženo 37x)Nepodařilo se někomu dostat efektně ty data z vloženého objektu Word dokumentu do buněk excelu?
Fyzicky to není problém (dvojklikem otevřít objekt, ctrl+a, ctrl+c, přejít do požadované buňky a paste) ale ve VBA mi to stále nefunguje.
Děkujicitovat
Fyzicky to není problém (dvojklikem otevřít objekt, ctrl+a, ctrl+c, přejít do požadované buňky a paste) ale ve VBA mi to stále nefunguje.
Děkujicitovat
(13.2.2018 15:24)#039523
V současnosti řeším podobný problém.
Předcházející řešení se mi sice zamlouvalo a i vyhovovalo, ale mělo jednu vadu na kráse... spojilo mi to vždy poslední řádek na stránce s prvním na následující. Bohužel jsem potřeboval poslední údaj ze stránky a nepovedlo se mi zjistit jaký separátor zadat pro rozdělení :(
Pokud by někdo věděl jak tomu spojení buď zabránit či jak následně v excelu rozdělit, byl bych vděčný.
Zatímně používám ne moc elegantní a nejvhodnější (avšak předchozím příspěvkem žádané) CTRL+A a CTRL+C takto (prodleva je úmyslná - bez ní zůstal ve schránce někdy stárý obsah) :
Dim WordApp As Object
Dim WordDoc As Object
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(ActiveWorkbook.Path & "\"NÁZEVWORD")
WordApp.Visible = True
Application.SendKeys "%ůlš"
Application.Wait (Now + TimeValue("0:00:04"))
Application.SendKeys "%ůc"
Windows("NÁZEVEXCEL").Activate
Sheets("LISTEXCEL").Select
Application.Wait (Now + TimeValue("0:00:04"))
Range("BUNKAEXCEL").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
WordDoc.Close
WordApp.Quitcitovat
Předcházející řešení se mi sice zamlouvalo a i vyhovovalo, ale mělo jednu vadu na kráse... spojilo mi to vždy poslední řádek na stránce s prvním na následující. Bohužel jsem potřeboval poslední údaj ze stránky a nepovedlo se mi zjistit jaký separátor zadat pro rozdělení :(
Pokud by někdo věděl jak tomu spojení buď zabránit či jak následně v excelu rozdělit, byl bych vděčný.
Zatímně používám ne moc elegantní a nejvhodnější (avšak předchozím příspěvkem žádané) CTRL+A a CTRL+C takto (prodleva je úmyslná - bez ní zůstal ve schránce někdy stárý obsah) :
Dim WordApp As Object
Dim WordDoc As Object
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(ActiveWorkbook.Path & "\"NÁZEVWORD")
WordApp.Visible = True
Application.SendKeys "%ůlš"
Application.Wait (Now + TimeValue("0:00:04"))
Application.SendKeys "%ůc"
Windows("NÁZEVEXCEL").Activate
Sheets("LISTEXCEL").Select
Application.Wait (Now + TimeValue("0:00:04"))
Range("BUNKAEXCEL").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
WordDoc.Close
WordApp.Quitcitovat
Strana: « předchozí 1
2
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články