Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Word nach Excel

Betrifft: Word nach Excel von: Badman
Geschrieben am: 13.08.2014 09:17:20

Hallo :)

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
Dieser Code hat mir auch geholfen, hier poppt aber das Fenster auf wo der Name verlangt wird, genau das darf nich passieren!
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
Vielen Dank für eure Zeit und Bemühung!

  

Betrifft: AW: Word nach Excel von: fcs
Geschrieben am: 13.08.2014 13:08:01

Hallo Badman,

warum denn schon wieder ein neuer Thread zum gleichen Thema?

Kommst du mit der Antwort hier jetzt weiter?
https://www.herber.de/forum/messages/1376108.html

Ansonsten, wenn möglich immer den kompletten Pfad von zu öffnenden Dateien angeben.
Wenn kein Pfad angegeben ist versuchen Word/Excel die Datei noch im aktiven Verzeichnis zu finden.
Wenn Word + Exceldatei immer im gleichen Verzeichnis liegen, dann kann man ggf. über den Pfad der geöffneten Worddatei das Verzeichnis der Exceldatei vorgeben.

Gruß
Franz


  

Betrifft: AW: Word nach Excel von: Badman
Geschrieben am: 13.08.2014 17:24:27

Hallo fcs,
den neuen Thread hab ich gemacht kurz bevor du geantwortet hast ^^ zu der Zeit hatte ich noch keine Lösung und dachte mir, ich starte das ganze neu (der übersicht wegen).

Vielen, vielen Dank nochmal. Du hast mir wirklich geholfen!

LG


  

Betrifft: AW: Word nach Excel von: Badman
Geschrieben am: 13.08.2014 17:30:26

kurze ergänzung:

ja ich kam mit deinem Code weiter und konnte alles wie ich es mir wünschte umsetzten

der Code sieht nun wie folgt aus:

Sub aaTest()
  
  Dim E As Object 'Excel.Application
  Dim xlWkb As Object 'Excel.Workbook
  
  Set E = CreateObject("Excel.Application")
  
  E.Visible = True
  
  Set xlWkb = E.Application.workbooks.Open(FileName:="D:\test.xlsx")
  If xlWkb.ReadOnly = True Then
    Application.Activate
    MsgBox "Die Datei """ & xlWkb.Name _
        & """ ist zur Zeit in Benutzung und wurde schreibgeschütz geöffnet." _
        & vbLf & "Datei wird wieder geschlossen und das Makro beendet.", _
        vbOKOnly, "Excel-Datei öffnen"
    xlWkb.Close savechanges:=False
    E.Quit
    GoTo Beenden
  End If
  
' weiterer Code

Set ws = xlWkb.Sheets("Datenbank")
Set d = ActiveDocument

i = 1
Do While ws.Cells(i, 4) <> ""
If ws.Cells(i, 4).Value <> "" Then
i = i + 1
End If
Loop

'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

'Excel-Datei speichern/schließen und Anwendung beenden
    
    xlWkb.Close savechanges:=True
    E.Quit
    Set w = Nothing
    Set ws = Nothing
    
Beenden:
  
End Sub

Das einzige was nicht ging war die Zeile: i = ws.Cells(ws.Cells.Rows.Count, 1).End(xlUp).Row + 1
hab ich dann halt kurzer Hand mit dem loop umgangen.

LG