Daten aus Excel ins Word schreibn. VBS

[Kotik]

Hallo,

ist es mit VBS möglich, z.B.

Excel: Zeile 122 bis 125 und in Spalte O und P.

soll nach Word geschickt und ganz unten nach dem ganzem

Text die Daten reinschreiben.

Wie ist es zu lösen?

Danke im Voraus!

[Der Kleine]

[sarkasmus]

Hallo,

ist es mit VBS möglich, z.B.

Excel: Zeile 122 bis 125 und in Spalte O und P.

soll nach Word geschickt und ganz unten nach dem ganzem

Text die Daten reinschreiben.

mit VBA

keine Ursache.

[/sarkasmus]

Gib mal mehr Input:

Ist das Worddokument ein festes Dokument mit fester Position und festem Namen? Ist das Dokument bereits geöffnet? Soll es hinterher geöffnet bleiben?

Ist das Excel-Dokument ein festes Dokument mit fester Position und festem Namen? Ist das Dokument bereits geöffnet? Soll es hinterher geöffnet bleiben?

Du wirst eines der beiden Programme durch das andere Steuern müssen.

Eigentlich nicht schwer.

nein

[Kotik]

Im Moment steuere ich das ganze über diesen Script:

Dim zaehler, Quelltabelle, QuellDokument, objXL, ObjWrd, ObjWrdDok

Set wshshell = CreateObject("WScript.Shell")

Set FSO = CreateObject("Scripting.FileSystemObject")

' ----------------------------------------------

' Das Hauptmenü:

' ----------------------------------------------

Do

Titel = "Auswahlmenü (by) Kotik"

Anzeige = "**************************************************************" & vbCRLF

Anzeige = Anzeige & "* Achtung: Beim Menüauswahl [2] *" & vbCRLF

Anzeige = Anzeige & "*"& vbTAB & vbTAB & vbTAB & vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "* Zuerst die:"& vbTAB & vbTAB & vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "*"& vbTAB & vbTAB &" Excel - Tabelle"& vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "* Danach die:"& vbTAB & vbTAB & vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "*"& vbTAB & vbTAB &" Word - Datei"& vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "*"& vbTAB & vbTAB & vbTAB & vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "* suchen und auswählen...!" & vbTAB & vbTAB & vbTAB &" *" & vbCRLF

Anzeige = Anzeige & "**************************************************************" & vbCRLF

Anzeige = Anzeige & " " & vbTAB & " " & vbCRLF

Anzeige = Anzeige & " [1] Schon im Script von mir festgelegter Pfad ...." & vbCRLF

Anzeige = Anzeige & " [2] Den Pfad zur Dateien selber festlegen ...." & vbCRLF

Anzeige = Anzeige & " " & vbTAB & " " & vbCRLF

Anzeige = Anzeige & " . . . was soll's denn sein?"

Eingabe = InputBox(Anzeige,Titel,1,,4000)

If Eingabe = "" Then ' Abbruch vom Benutzer

aktAusw = MsgBox(". . . wirklich beenden?", vbYesNo + vbDefaultButton1 + vbQuestion, Titel)

'aktAusw = MsgBox(". . . wirklich beenden?", vbYesNo + vbDefaultButton2 + vbQuestion, Titel)

If aktAusw <> vbNo Then

WScript.Quit

End If

End If

'If Eingabe <> "1" AND Eingabe <> "2" Then WScript.Quit

'If UCase(Eingabe) = "1" Then sFest

If Eingabe = "1" Then sFest

If Eingabe = "2" Then sSelber

Loop

' ----------------------------------------------

' Pfad festlegen:

' ----------------------------------------------

Sub sFest 'Schon festgelegt

Quelltabelle = "D:\Downloads\Sergej\Kopie von TelefonNummer.xls"

QuellDokument = "D:\Downloads\Sergej\EVN.doc"

sSuchen 'Bearbeitung

End Sub 'sFest

' ----------------------------------------------

' Pfad auswahl:

' ----------------------------------------------

Sub sSelber 'Selber den Pfad festlegen

'********************************************************************************************

Set Dialog = CreateObject("UserAccounts.CommonDialog")

' Dialog.Filter = "Text Files|*.txt|All Files|*.*" ' zeigt nur *.txt

' Dialog.Filter = "Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*" ' zeigt nur *.xls

Dialog.Filter = "Alle Dateien|*.*" ' zeigt nur *.* - also ALLES

' Dialog.Filter = "Textdateien|*.txt|Excel-Arbeitsmappen|*.xls|Alle Dateien|*.*"

Dialog.FilterIndex = 3 ' von den drei auswählbaren Filtern wird der 3. eingesetzt

Dialog.ShowOpen 'Zuerst die Excel-Tabelle auswählen

Quelltabelle = Dialog.FileName

Dialog.ShowOpen 'Danach die Word-Datei wählen

QuellDokument = Dialog.FileName

sSuchen 'Bearbeitung

'********************************************************************************************

End Sub 'sSelber

' ----------------------------------------------

' Dateien öffnen:

' ----------------------------------------------

Sub sSuchen 'Sucht nach Nummern

If fso.FileExists(Quelltabelle) Then

If fso.FileExists(QuellDokument) Then

'--Öffnen der Excel-Quelltabelle

Set objXL = CreateObject("Excel.Application")

objXL.Visible = True

objXL.Workbooks.open(Quelltabelle)

'--Öffnen des Word-Dokuments

Set ObjWrd = CreateObject("Word.Application")

ObjWrd.Visible = True

ObjWrd.documents.open(QuellDokument)

Set ObjWrdDok = ObjWrd.activeDocument

'MsgBox "Jetzt geht`s los!"

'--Hier werden die Sachen eingetragen, die die in Excel

'--durchgesucht werden müssen!

'--Spalte,VonZeile,BisZeile

Schleifensuche 3,23,46

Schleifensuche 3,51,53

Schleifensuche 3,57,57

Schleifensuche 3,61,65

Schleifensuche 3,106,116

Schleifensuche 4,23,46

Schleifensuche 4,51,53

Schleifensuche 4,57,57

Schleifensuche 4,61,65

Schleifensuche 4,106,116

Schleifensuche 11,2,120

'WScript.Sleep 1000

'test = zaehler

'MsgBox "Es wurden " & test & " Nummern gefunden!"

Else

msgbox "QuellDokument " & QuellDokument & " existiert nicht"

End If

Else

msgbox "Quelltabelle " & Quelltabelle & " existiert nicht"

End If

WScript.Quit

End Sub

' ----------------------------------------------

' Nummer suchen und markieren:

' ----------------------------------------------

Sub Schleifensuche (Spalte,VonZeile,BisZeile)

Set ObjWrdDok = ObjWrd.activeDocument

'--Schleife durch die Exceltabelle

i = VonZeile

Do

objXL.Statusbar = "Suche in Spalte: " & Spalte & " und in Zeile: " & i & " nach " & objXL.Cells(i,Spalte).value

With ObjWrdDok.Content.Find

.ClearFormatting

.Text = objXL.Cells(i,Spalte).value

.Replacement.Highlight = true

.Forward = True

.Replacement.Text = objXL.Cells(i,Spalte).value

zaehler = zaehler + 1

'if .Execute (,,,,,,,,,,2) = true then Msgbox objXL.Cells(i,Spalte).value & " Wurde gefunden!!"

.execute ,,,,,,,,,,2 'das macht einen "Replace All" mit demselben Inhalt aber anderer formatierung

End With

If i = BisZeile Then Exit Do

i = i + 1

loop While Len (objXL.Cells(i,Spalte).Value) < 30

End Sub

Ich wollte es etwas erweitern, um diese

Gesamt Netto: 6,94 €

Grundgebühr: 8,60 €

MwSt: 2,95 €

Gesamt Brutto: 18,50 €

Daten ins Word ganz unten rein schreiben (nach einander, wie die Abbildung).

Beide Dateien sind schon geöffnet.

Ich dachte mir es wäre wenig Arbeit um das zu erledigen, aber wenn es mit VBS schwer geht, dann lass ich es.

Danke im Voraus!

[Kotik]

Bitte um Rat.