Word nach Excel
13.08.2014 09:17:20
Badman
Mein Ziel ist es, in Word-VBA ein Modul zu programmieren, dessen Funktion es ist, eine [b]gezielte[/b] Excel-Mappe (.xlsx) zu öffnen (nicht schreibgeschützt!), dann etwas in die Datenbank einzutragen und danach [b]unter selben Namen speichern und schließen[/b]. Unter diesem Vorgang darf [b]kein Fenster[/b] aufpoppen was zb. nach dem Namen der zu öffnenden Mappe fragt o.ä. Am besten bekommt der User garnicht mit dass Excel sich öffnet und schließt, es muss alles ganz automatisch klappen. Ich weiss nicht ob es hier besser ist den Pfad oder den Namen anzugeben usw.. da brauch ich ein paar anschubser.
Ich bin bisher so weit gekommen: (Ich weiss, alles ein durcheinander :? )
Sub test()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim strFilename
Dim i As Long
On Error Resume Next
Set w = GetObject(, "Excel.Application")
If Err.Number 0 Then
Set w = CreateObject("Excel.Application")
Err.Clear
End If
Set ws = Excel.Application.ActiveSheet
'strFilename = Excel.Application.GetOpenFilename("Excel-Mappe, *.xlsx", "test")
'If strFilename = False Then Exit Sub
'w.Visible = True
'w.Application.Workbooks.Open FileName:="test"
'w.Application.Visible = True
Set d = w.Documents.Open("test")
i = ws.Cells(ws.Cells.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(i, 1) = d.Bookmarks("Ort").Range & " " & d.Bookmarks("Datum").Range 'Ort, Datum
ws.Cells(i, 2) = d.Bookmarks("Name").Range 'Aussteller Name
ws.Cells(i, 3) = d.Bookmarks("Email").Range 'Aussteller E-mail
ws.Cells(i, 4) = d.Bookmarks("AngebotNR").Range 'Angebot Nr
ws.Cells(i, 5) = d.Bookmarks("AufzugsanlageNR").Range 'Aufzugsanlage Nr
ws.Cells(i, 6) = d.Bookmarks("AdresseAufzug").Range 'Adresse
ws.Cells(i, 7) = d.Bookmarks("KundeName").Range 'Kunde Name
ws.Cells(i, 8) = d.Bookmarks("Vortext").Range 'VT
ws.Cells(i, 9) = d.Bookmarks("Kurztext1").Range '1. KT
ws.Cells(i, 10) = d.Bookmarks("Langtext1").Range '1. LT
'ws.Cells(i, 11) = d.bookmarks("PreisBrutto").Range '1. Preis
ws.Cells(i, 11) = d.Bookmarks("Kurztext2").Range '2. KT
ws.Cells(i, 12) = d.Bookmarks("Langtext2").Range '2. LT
'ws.Cells(i, 14) = d.bookmarks("PreisBrutto").Range '2. Preis
'ws.Cells(i, 15) = d.bookmarks("Kurztext2").Range '3. KT
'ws.Cells(i, 16) = d.bookmarks("Langtext2").Range '3. LT
'ws.Cells(i, 17) = d.bookmarks("PreisBrutto").Range '3. Preis
ws.Cells(i, 13) = d.Bookmarks("PreisBrutto").Range 'Preis Brutto
d.Close False
Set d = Nothing
w.Quit
Set w = Nothing
Set ws = Nothing
End Sub
Sub ablage()
Application.ScreenUpdating = False
Dim myApp As Excel.Application
Dim myBook As Excel.Workbook
Dim mySheet As Excel.Worksheet
Set myApp = CreateObject("Excel.Application")
Set myBook = myApp.Workbooks.Add
Set mySheet = myBook.Worksheets(1)
Dim sp As Long, ze As Long
ze = 2
For sp = 1 To ActiveDocument.Paragraphs.Count
mySheet.Cells(ze, sp).Value = ActiveDocument.Paragraphs(sp)
Next
myApp.Visible = True
Set myApp = Nothing
End Sub