Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
352to356
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
352to356
352to356
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kopieren zw. Word und Excel

Kopieren zw. Word und Excel
16.12.2003 12:05:33
MarkusKl
Hallo zusammen,

ich stehe vor einem kleinen Problem. Eine Excel Tabelle ist in mein Word Dokument eingebettet und hier werden verschiedene ArtikelNr eingegeben, die dann später mit einer Excel Tabelle abgeglichen werden sollen.

Da ich bisher noch nie zwischen Word und Excel ein Makro habe laufen lassen komme ich jetzt leider nicht weiter. Beide dateien liegen im gleichen Verzeichnis, doch ich bekomme gleich die Fehlermeldung "Es ist keine Testdatei geöffnet!" Es kann auch daran liegen dass ich das Word Dokument im Makro nicht richtig bezeichnet habe, da ich hier keine passende Hilfe gefunden habe.

Hoffentlich kann mir jemand weiterhelfen wo mein Fehler liegt.
Besten Dank
Markus


Sub Find_ArtNr_Beschr()
' Makro soll anhand der eingegebenen ArtikelNr die beschreibung
' und andere dazugehörige Werte finden.
Dim wkb As Workbook
Dim wkb2 As Workbook
Dim wks As Worksheet
'Dim rng As Range
On Error Resume Next
Set wkb = Workbooks("Test.xls")
Set wkb2 = Workbooks("Rechnungstemplate Maxdata.doc")
If Err > o Or wkb Is Nothing Then
Beep
MsgBox _
prompt:="Es ist keine Testdatei geöffnet!"
Exit Sub
End If
Set wks = wkb.Worksheets("Tabelle1")
If Err > o Or wks Is Nothing Then
Beep
MsgBox _
prompt:="Die Testdatei enthält das Zielblatt nicht!"
Exit Sub
End If
' Worddoc Tabelle 1 unabhängig vom Namen aktivieren
wkb2.Sheets(1).Activate
' Zählt die Anzahl der Zeilen
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
' Vergleiche Tabelle 1 Spalte 1 Reihe i mit ...
For i = 1 To lastrow
Wert = Cells(i, 1).Value
' ... Tabelle 2 Spalte 1 (komplett)
With wkb.Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Beschr = C(1, 2)
St_Pr = C(1, 6)
Cells(i, 1) = Beschr
Cells(i, 3) = St_Pr
End If
End With
Next i
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren zw. Word und Excel
19.12.2003 09:00:35
Nicolaus
Hallo,
der Knackpunkt scheint in der Objektart zu liegen, da dein Script ein Worddok als Workbook zu behandeln versucht. Ansprechen willst du aber ein Worksheet in einem Worddok. Gehen tut das, frag mich aber bitte nicht wie genau...

Ein einfacher Lösungsweg wäre folgender:

Baue die Exceltabelle doch anstelle sie einzubetten als verknüpfte Datei in dein Worddokument ein. Die Exceldatei die dann deine Daten enthält kannst du dann auf gewohnte Weise ansprechen.

Nicolaus
AW: Kopieren zw. Word und Excel
19.12.2003 10:08:43
Markus
Hallo Nicolaus,

danke für die Antwort, ich habe jedoch das Problem schon gelöst. Frag mich nicht mehr wie, aber durch selektives Beseitigen der Fehler kommt man meistens weiter ;-) Vielleicht kann ich mit dem Code ja der Nachwelt noch einen Gefallen tun.

Gruß
Markus

---------------------------------------------------------------


Sub Find_ArtNr_Beschr()
' Makro soll anhand der eingegebenen ArtikelNr die beschreibung
' und andere dazugehörige Werte finden.
Dim wkb As Workbook
Dim wkb2 As Workbook
Dim wks As Worksheet
'Dim rng As Range
On Error Resume Next
Set wkb = Workbooks("Test.xls")
Set wkb2 = Workbooks("Rechnungstemplate.doc")
If Err > o Or wkb Is Nothing Then
Beep
MsgBox _
prompt:="Es ist keine Testdatei geöffnet!"
Exit Sub
End If
Set wks = wkb.Worksheets("Tabelle1")
If Err > o Or wks Is Nothing Then
Beep
MsgBox _
prompt:="Die Testdatei enthält das Zielblatt nicht!"
Exit Sub
End If
' Worddoc Tabelle 1 unabhängig vom Namen aktivieren
wkb2.Sheets(1).Activate
' Zählt die Anzahl der Zeilen
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
' Vergleiche Tabelle 1 Spalte 1 Reihe i mit ...
For i = 1 To lastrow
Wert = Cells(i, 1).Value
' ... Tabelle 2 Spalte 1 (komplett)
With wkb.Sheets(1).Columns(1)
Set C = .Find(Wert, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Beschr = C(1, 2)
St_Pr = C(1, 6)
Cells(i, 1) = Beschr
Cells(i, 3) = St_Pr
End If
End With
Next i
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige