Kotik

Bitte um Rat.

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!

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!