Thema Datum  Von Nutzer Rating
Antwort
Rot Daten aus Word Formular an Excel übergeben
22.01.2014 12:45:36 Manuel
NotSolved
22.01.2014 16:55:08 Neuhäusler Korbinian
NotSolved

Ansicht des Beitrags:
Von:
Manuel
Datum:
22.01.2014 12:45:36
Views:
1503
Rating: Antwort:
  Ja
Thema:
Daten aus Word Formular an Excel übergeben

Guten Tag.

Ich habe ein Word Formular erstellt. Mit Pflichtfeldern, DropDowns etc.

Nun gibt es bestimmte Felder dieses Formulars die in eine Excel Tabelle übertragen werden sollen. Möglichst ohne das der Benutzer des Formulars dafür viel tun muß (VBA Kenntnisse).

Ist es möglich, das man den Code so gestalltet, das man die Felder ausfüllt und diese bereits an Excel übergeben werden sobald das Feld fertig ausgefüllt wurde, bzw. sobald ein neues Feld zur bearbeitung markiert wurde?

Ich habe mit meinen geringen VBA Kenntnissen bereits etwas rumprobiert der Code funktioniert aber noch nicht wirklich. Ausserdem fehlen die Teile an Code die das in den bestimmten Feldern eingegebene direkt an Excel übergeben. (Wenn dies denn überhaupt möglich ist).

 

Falls dies nicht realisierbar sein sollte, was wäre denn möglich?

 

Hier ist erst einmal der Code den ich erstellt habe.

Vorschläge und Kritik sind sehr willkommen!

 

Sub Transfer_Data()
   Dim xlApp As Object
   Dim xlWBook As Object
   Dim fld As FormField
   Dim nRow As Long
   Dim nCol As Integer

    Set xlApp = CreateObject("excel.Application")
    'Set xlWBook = xlApp.Workbooks.Open(FileName:="*\Geräteliste.xls")
    xlWBook.Application.Visible = True
    xlWBook.Application.Sheets("Geräteübersicht").Select
    nRow = xlWBook.Application.Range("A65536").End(xlUp).Row + 1

    'ActiveDocument.Unprotect

    nCol = 1

  
    nInstall = ActiveDocument.FormFields("Gebäude").Result
    nEqui = ActiveDocument.FormFields("EquiNr").Result
    nTyp = ActiveDocument.FormFields("Typ").Result
    nPTB = ActiveDocument.FormFields("PTB").Result
    nFFS = ActiveDocument.FormFields("FFA").Result
    nSNR = ActiveDocument.FormFields("SNR").Result
    nPMBAR = ActiveDocument.FormFields("PMBAR").Result
    nVMBAR = ActiveDocument.FormFields("VMBAR").Result
    nPVDTNG = ActiveDocument.FormFields("PVDTNG").Result
    nVVDTNG = ActiveDocument.FormFields("VVDTNG").Result
    nMWRKST = ActiveDocument.FormFields("MWRKST").Result
    nProzMed = ActiveDocument.FormFields("ProzMed").Result
    'nStatus = ComboBox1.Value


    xlWBook.Application.Cells(nRow, 1).Value = ActiveDocument.FormFields("Installationsort").Result
    xlWBook.Application.Cells(nRow, 2).Value = ActiveDocument.FormFields("Equipment").Result
    xlWBook.Application.Cells(nRow, 3).Value = ActiveDocument.FormFields("Gerätetyp").Result
    xlWBook.Application.Cells(nRow, 4).Value = ActiveDocument.FormFields("Zulassung").Result
    xlWBook.Application.Cells(nRow, 5).Value = ActiveDocument.FormFields("Filtersatz").Result
    xlWBook.Application.Cells(nRow, 6).Value = ActiveDocument.FormFields("Hersteller-Nr.").Result
    If ComboBox1.List.Result = "Armatur funktionssicher instandgesetzt." Then
       xlWBook.Application.Cells(nRow, 7).Value = "OK"
    ElseIf ComboBox1.List.Result = "Weitere Maßnahmen erforderlich. (siehe Text)" Then
       xlWBook.Application.Cells(nRow, 7).Value = "Beanstandet"
    Else
       xlWBook.Application.Cells(nRow, 7).Value = "Keine Wartung"
    End If
    xlWBook.Application.Cells(nRow, 8).Value = ActiveDocument.FormFields("Druck").Result
    xlWBook.Application.Cells(nRow, 9).Value = ActiveDocument.FormFields("Vakuum").Result
    xlWBook.Application.Cells(nRow, 10).Value = ActiveDocument.FormFields("Ü-Druck Dichtung").Result
    xlWBook.Application.Cells(nRow, 11).Value = ActiveDocument.FormFields("U-Druck Dichtung").Result
    xlWBook.Application.Cells(nRow, 12).Value = ActiveDocument.FormFields("Membran").Result
    xlWBook.Application.Cells(nRow, 13).Value = ActiveDocument.FormFields("Prozessmedium").Result
    
    ActiveDocument.Protect (wdAllowOnlyFormFields)
    ActiveDocument.Fields(1).Select

    xlWBook.Close savechanges:=True

    ActiveDocument.FormFields("Installationsort").Result = nInstall
    ActiveDocument.FormFields("Equipment").Result = nEqui
    ActiveDocument.FormFields("Gerätetyp").Result = nTyp
    ActiveDocument.FormFields("Zulassung").Result = nPTB
    ActiveDocument.FormFields("Filtersatz").Result = nFFS
    ActiveDocument.FormFields("Hersteller-Nr.").Result = nSNR
    ComboBox1.List.Result = nStatus
    ActiveDocument.FormFields("Druck").Result = nPMBAR
    ActiveDocument.FormFields("Vakuum").Result = nVMBAR
    ActiveDocument.FormFields("Ü-Druck Dichtung").Result = nPVDTNG
    ActiveDocument.FormFields("U-Druck Dichtung").Result = nVVDTNG
    ActiveDocument.FormFields("Membran").Result = nMWRKST
    ActiveDocument.FormFields("Prozessmedium").Result = nProzMed
    
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Daten aus Word Formular an Excel übergeben
22.01.2014 12:45:36 Manuel
NotSolved
22.01.2014 16:55:08 Neuhäusler Korbinian
NotSolved