MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Word
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 12.09.2017, 23:35   #1
StokE_182
Neuer Benutzer
Neuer Benutzer
Standard Word 2010 - Fragen zu Textmarken füllen

Hallo,

Es geht darum eine Word-Vorlage mit Daten aus einer Exceltabelle zu füllen. Es gibt dazu eine Vielzahl von Beiträgen und ich habe mich an folgender Lösung orientiert: https://www.online-vba.de/vba_tutorialvorlage.php. Jetzt würde ich aber gerne Dinge hinzufügen bzw. ändern und hoffe mir kann jemand dabei helfen.

Habe eine Beispieltabelle angehängt, damits verständlicher wird:

1. den ersten Teil der Tabelle (Name, Typennummer, Verkauf seit) kann ich bereits mit dem oben verlinkten Code in das Worddokument übernehmen lassen.
Im zweiten Teil der Tabelle soll NICHT der Inhalt der Zelle selbst in die Textmarke des Worddokuments übernommen werden, sondern (falls ein "x" in der Zelle steht) der Text aus der Beschriftungszeile (Zeile 4 im Beispiel).
Fall dort kein "x" steht, soll die nächste Spalte überprüft werden und so weiter bis zur letzten Spalte

2. in Spalte D ist ein Datum eingetragen. Dieses sollte im amerikanischen Format ins Worddokument übernommen werden (unbhängg von der Excelformatierung wird das Datum bei mir derzeit zu TT.MM.JJJJ in Word)

3. Ich würde gerne, dass automatisch die Worddatei im gleichen Ordner (wie die Vorlagendatei) abgespeichert wird. Als Dateiname soll im Idealfall direkt der Eintrag aus der Spalte "Name" verwendet werden.

4. Gleichzeitig wäre es toll die Datei im selben Rutsch zusätzlich auch als PDF mit gleichem Namen abgespeichert werden könnte.

5. Was muss ich angeben, damit ich nicht den gesamten Pfad der Exceldatei eintragen muss? Damit der Code auch auf anderen Computern funktioniert wäre es toll wenn die Exceldatei mit den Daten einfach im gleichen Ordner liegen müsste um ausgelsesen werden zu können.

Vielen Grüße
StokE
Angehängte Dateien
Dateityp: xls Beispiel.xls (31,0 KB, 7x aufgerufen)
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.09.2017, 12:48   #2
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo stoke,

zu Punkt 5:
Wenn Exceldatei und Worddokument im gleichen Ordner liegen, kannst du den Pfad zur Exceldatei so definieren:

pfad = Thisdocument.path & "\beispiel.xls"

Thisdocument.path repräsentiert dabei den Speicherort (ohne abschließenden Backslash) desjenigen Dokuments, in dem das Makro enthalten ist.

Für die übrigen Punkte stell bitte deinen bishergen angepassten Code inclusive des (bei Bedarf anonymisierten) Worddokuments zur Verfügung. Es hat wohl keiner Lust (ich auch nicht), ein komplettes Tutorial durchzuackern und deine vermutlichen Anpassungen nachzuempfinden, um dir Tipps geben zu können.

__________________

Gruß
Gerhard

Geändert von Gerhard H (15.09.2017 um 13:37 Uhr). Grund: Verschluckten Backslash restauriert
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 26.09.2017, 18:52   #3
bclcra
Neuer Benutzer
Neuer Benutzer
Standard

Hallo stoke,

zu Punkt 1:

Woher kommen die Daten in der Excel-Tabelle? Stehen sie an einem zentralen Ort allen Usern zur Verfügung?
Wie sollen die Daten aus der Excel-Tabelle dargestellt werden, als Textfeld irgendwo im Formular oder als Tabelle?

Irgendwo im Text: Verknüpfe die Excel-Tabelle als Datenquelle zum Serienbrief. Hier gibt es genügend Steuerungsmöglichkeiten um aus einem x ein Autoradio werden zu lassen.

Darstellung als Tabelle: Nutze die Database-Anweisung (Einfügen-> Schnellbausteine-> Feld). Hier kannst du die Excel-Tabelle einbinden und ggf. noch weitere Einschränkungen zur Datenauswahl treffen.

Gruß Torsten
bclcra ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.09.2017, 22:16   #4
StokE_182
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

bitte entschuldigt die Verzögerung, aber die Prioritäten auf Arbeit hatten sich geändert.

Habe jetzt Beispiele für das Worddokument (welches später mit den Daten gefüllt werden soll) und die Exceltabelle mit den dafür vorgesehenen Daten erstellt.
Die Exceltabelle enthält auch noch kurze Anmerkungen. Hoffe damit ist es leichter verständlich was passieren soll.

Anmerkung: Bevor das Makro startet, müsst ihr noch den Speicherort der Exceltabelle anpassen.

@Gerhard: Vielen Dank für den Hinweis mit dem Dateipfad. Leider muss ich gestehen, dass ich es jetzt noch nicht in der Beispieldatei implementiert habe.

Würde mich sehr freuen wenn mir mit den Beispieldateien jemand bei den im ersten Post genannten Problemen helfen könnte.

Übrigens bin ich gerade über noch etwas gestolpert:
Die in der Beispieltabelle als "Features" bezeichneten Einträge sollen später im Worddokument schlicht hintereinander weg aufgelistet werden. Daher müssen sie mit einem Komma getrennt werden.
Mein Problem ist jetzt: hinter das letzte Feature soll ja kein Komma und dafür müsste in irgendeiner Form nach jedem Feature geprüft werden, ob noch ein weiteres eingetragen ist. Falls ja --> "," falls nein --> nichts
Vielleicht hat jemand von euch dafür eine elegante Lösung.


Viele Grüße
StokE
Angehängte Dateien
Dateityp: dotm BeispielDokument.dotm (23,8 KB, 8x aufgerufen)
Dateityp: xlsx BeispielTabelle.xlsx (16,0 KB, 4x aufgerufen)
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.09.2017, 01:55   #5
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo stoke,

ein paar Teilvorschläge:

Zu Punkt 1:
das einfachste wäre natürlich, du würdest statt der x-en die tatsächlichen Features eintragen.

Wenn das aus irgendeinem Grund nicht möglich ist, musst du halt für jeden Eintrag prüfen, ob es ein x gibt. Hier am Bespiel von Feature 1:
Code:

If CStr(.Cells(lZeile, 7).Value) = "x" Then
      ActiveDocument.Bookmarks("Feature1").Range.Text = _
      CStr(.Cells(2, 7).Value) 'Zeile 2
Else
      ActiveDocument.Bookmarks("Feature1").Range.Text = "???"
End If
Die Geschichte mit den Kommas könnte man hinterher erledigen, indem man nämlich in der Wordtabelle, wo die Features stehen, einfach das letzte Komma und / oder doppelte Kommata vom Makro wieder rauslöschen lässt. Wie genau man da vorgehen kann, hängt davon ab, was eingetragen werden soll, wenn es kein x gibt.

Zu Punkt 3
du könntest das Datum als Text eintragen (d.h. vor dem Eintragen zuerst ein Hochkomma tippen). Falls du jedoch das englische Datum nicht ändern willst / darfst, geht das meiner Meinung nach nur, indem du in der Systemsteuerung von Windows unter Sprache und Region das englische Datumsformat einstellst.

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.10.2017, 14:22   #6
StokE_182
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

Kurze Rückmeldung:

Die Sache mit den Kommata hat sich erledigt. Es scheint ein "Feature" zu geben, welches bei allen "Autos" vorkommt und auch als letztes aufgezählt werden kann (in meinem Beispiel wäre das so etwas wie "Zentralverriegelung"). Dadurch kann ich jedes Feature mit einem Komma enden lassen. Als letztes kommt "Zentralverriegelung ohne Komma und alles passt.

Zum Datumsformat habe ich auch eine Lösung gefunden: Ich kann in Excel mit der Funktion =TEXT das Datum als Text aus einer anderen Zelle übernehmen und dann die Text-Zelle in die Textmarke im Word-Dokument einfügen lassen. Somit kann ich auch noch zuvor mit dem Datum rechnen (ich brauche nämlich auch noch ein "gültig bis" was den Startdatum plus 3 Jahre minus 1 Tag entspricht) und anschließend trotzdem bequem übernehmen lassen.

Damit bleibt nur noch eine Kleinigkeit: Will ich das aufgefüllte Dokument speichern, wird "Dokument1.docx" als Dateiname vorgeschlagen. Komfortabler wäre es jedoch wenn der Dateiname bereits in folgender Form eingetragen wäre
Code:

"Angebot" [Textmarke Name] [Textmarke Datum].docx
Wobei "Angebot" hier immer gleich wäre und nur die beiden Textmarken entsprechend eingetragen werden sollen.

Wäre toll wenn jemand dazu noch Hilfe für mich hätte.


Vielen Dank
StokE
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.10.2017, 00:52   #7
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo stoke,

da beim Eintragen der Werte in die Textmarken diese standardmäßig zerstört werden, musst du die Teilnamen fürs Speichern aus den Excel-Zellen holen. Gemäß deines Beispiels wären das:
NameAuto: .Cells(lZeile, 2).Value
verfuegbar: .Cells(lZeile, 6).Value

Der Name fürs Speichern würde sich also so zusammensetzen (in diesem Beispiel wird in den Ordner gespeichert, in dem auch die Dokumentvorlage liegt):

Code:

dim speichername as string
speichername = ThisDocument.Path & "" & CStr(.Cells(lZeile, 2).Value) & "_" & .Cells(lZeile, 6).Value & ".docx"
Diese Zeile platzierst du am besten zwischen Loop und End With in deinem Makro, auf jeden Fall aber bevor die Excel-Mappe geschlossen wird.

Für den Speichervorgang (den du dann auch nach Schließen der Mappe starten kannst) hast du zwei Optionen:

Wenn neben dem Dateinamen auch der Pfad bekannt ist, kannst du das Speichern direkt vom Makro erledigen lassen, ohne dass der Anwender eingreifen muss, etwa so:
Code:

ActiveDocument.SaveAs2 speichername
Oder du willst dem Anwender die Wahl lassen, in welchen Ordner er speichern will, dann so:
Code:

Dim SpeicherDialog As FileDialog
Set SpeicherDialog = Application.FileDialog(msoFileDialogSaveAs)

With SpeicherDialog
    .InitialFileName = speichername
    If .Show = True Then .Execute
End With

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.10.2017, 20:36   #8
StokE_182
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

@Gerhard: Die Teilnamen aus den Excel-Zellen zu holen kommt mir sogar sehr gelegen. Dann kann ich nämlich sogar unsere "intere" Bezeichnung für das Auto im Dateinamen verwenden. Übertragen auf meine Beispiedatei wäre das dann Spalte A nach der auch schon zu Beginn ausgewählt wird. Die Spalte A wird ja nicht in eine Textmarke übertragen, weshalb ich schon überlegt hatte, welche Textmarke wohl noch am besten verwendet werden könnte. Spalte A wäre also sogar optimal.

Nun ist es mir schon etwas unangenehm, aber ich schaffe es nicht den eigentlich schon fertigen code korrekt einzufügen. Zuletzt bekam ich eine "loop ohne do"-Fehlermeldung als ich die Codezeilen mit der Prüfung ob ein "x" in der Zelle steht hinter die Codezeilen einfügen wollte, die die Textmarken ausfüllen.

Also diese Codezeilen:
Code:

If CStr(.Cells(lZeile, 7).Value) = "x" Then
      ActiveDocument.Bookmarks("Feature1").Range.Text = _
      CStr(.Cells(2, 7).Value) 'Zeile 2
Else
      ActiveDocument.Bookmarks("Feature1").Range.Text = "???"
End If
Könnte mir bitte nochmal jemand dabei Hilfe leisten?

Zum Speichernamen:
Zu meinem Verständnis: Funktioniert der Code so, dass ich (nachdem die Textmarken eingefügt wurden) normal auf das "Speichern"-Symbol in Word klicken kann und der Dateiname nach dem oben genannten Schema "Angebot [Textmarke Name]_[Textmarke Datum].docx" vorbelegt ist?
Falls ja, würde ich die Option vorziehen, dass der Nutzer den Speicherort noch selber wählen kann favorisieren (also Gerhard 2. Code).

Zum ersten Teil hat Gerhard ja genau beschrieben wo er eingefügt werden muss, beim zweiten Teil (also dem hier:
Code:

Dim SpeicherDialog As FileDialog
Set SpeicherDialog = Application.FileDialog(msoFileDialogSaveAs)

With SpeicherDialog
    .InitialFileName = speichername
    If .Show = True Then .Execute
End With
weiß ich wieder nicht wo genau im Makro der Code eingefügt werden muss, damit er wie gewünscht funktioniert.

Wie zuvor: Wäre sehr dankbar für eure Hilfe


Viele Grüße
StokE
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.10.2017, 00:44   #9
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo stoke,

könntest du nochmal den gesamten aktuellen Code für den CommandButton1 herzeigen, der den Fehler auslöst?

Zum Speichern:
Das ist so geplant, dass das Speichern-Unter-Dialogfeld ganz automatisch mit dem vorbelegten Pfad & Dateinamen erscheint, ohne dass man auf Speichern Unter klicken muss.

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.10.2017, 21:19   #10
StokE_182
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

wie vorgeschlagen hier der komplette Code zu dem Makro.
Habe die Teile in denen ich versucht habe hier vorgeschlagene Codezeilen einzubauen jeweils mit "Anmerkung StokE:" betitelt (sind 2 Stück), damit man sie auch zwischen den anderen Kommentaren erkennt.

Zum Speichern:
Dass der "Speichern unter" Dialog automatisch auftaucht, muss gar nicht sein. Denke in der Praxis wird man vor dem Speichern eher nochmal drüberschauen wollen und dann selber auf Speichern klicken (zumindest bis man diesem Makro und der Wordvorlage vertraut ).
Dennoch wäre es prima wenn dann beim Speichern der Dateiname bereits nach dem oben genannten Schema eingetragen wäre.
Ist das auch möglich? Und falls ja, könnte das jemand ebenfalls in den Code einbauen oder zumindest (idiotensicher) beschrieben wo er einkopiert werden muss?

Code:

Option Explicit
' ************************************************************************************************
' Autor und Copyright: Marc Wershoven
' http://www.online-vba.de - E-Mail: info@online-vba.de
' ------------------------------------------------------------------------------------------------
' Wichtige Hinweise:
' - Verwendung der Quelltexte auf eigene Gefahr!
' - Bitte beachten Sie die Nutzungsbedingungen von www.online-vba.de!
' - Dieser Hinweis inkl. Autorennennung darf nicht entfernt werden!
' - Jede Weiterübermittlung, Veröffentlichung oder Verbreitung ist untersagt!
' - Eine kommerzielle/gewerbliche Verwendung ist nicht gestattet!
' ************************************************************************************************
' Diese Hinweise beziehen sich auf den Quelltext, wie dieser unter dem folgenden Link, unverändert
' als Original zu sehen ist und gelten nicht für Veränderungen durch Nutzer bzw. Dritte:
' www.online-vba.de/vba_tutorialvorlage.php
' ************************************************************************************************

'In dieser Konstanten speichern wir uns
'den Pfad und den Dateinamen der Adressliste (Excel)
'Bitte entsprechend anpassen!
Private Const sAdressDatei As String = _
"C:..............................BeispielTabelle.xlsx"


'Anmerkung StokE:
'Hier der Versuch den Pfad für die Exceldatei mit den Daten für die Textmarken so anzugeben, dass es derselbe wie der des Word-Dokuments ist:
'soweit ich mich jetzt eingelesen habe kann ich nicht "Private Const sAdressDatei As String = ThisWorkbook.Path & "Beispieltabelle.xlsx" verwenden,
'sondern muss eine Variable setzen. Leider hilft mir diese Aussage nicht. Hilfe?

'Der Vorschlag von Gerhard H war pfad = Thisdocument.path & "beispiel.xls" zu verwenden. Ich vermute mal, dass es keinen Untrschied macht, ob ich
'ThisWorkbook.Path oder Thisdocument.path verwende.
'Anmerkung Ende

'Wie heisst das Tabellenblatt, auf welchem sich die Adressen befinden?
'Bitte entsprechend anpassen!
Private Const sTabellenblatt As String = "Tabelle1"

Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
  
     'Nur wenn ein Eintrag in der Liste markiert ist, wird das Makro ausgeführt
     If ListBox1.ListIndex >= 0 Then
    
         'Zuerst wird die Excel Datei geöffnet
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
    
         lZeile = 5 'Wir starten in Zeile 5, da in der ersten Zeilen überschriften stehen
         With oExcelWorkbook.sheets(sTabellenblatt)
             Do While .Cells(lZeile, 2) <> ""
                 'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
                 'übereinstimmt, dann werden die Textmarken gefüllt!
                 If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
                     'Eintrag gefunden, Textmarken füllen
                     ActiveDocument.Bookmarks("NameAuto").Range.Text = _
                         CStr(.Cells(lZeile, 2).Value)
                     ActiveDocument.Bookmarks("Typennummer").Range.Text = _
                         CStr(.Cells(lZeile, 3).Value)
                     ActiveDocument.Bookmarks("kw").Range.Text = _
                         CStr(.Cells(lZeile, 4).Value)
                     ActiveDocument.Bookmarks("PS").Range.Text = _
                         CStr(.Cells(lZeile, 5).Value)
                     ActiveDocument.Bookmarks("verfuegbar").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     ActiveDocument.Bookmarks("Feature1").Range.Text = _
                         CStr(.Cells(lZeile, 7).Value)
                     ActiveDocument.Bookmarks("Feature2").Range.Text = _
                         CStr(.Cells(lZeile, 8).Value)
                     ActiveDocument.Bookmarks("Feature3").Range.Text = _
                         CStr(.Cells(lZeile, 9).Value)
                     ActiveDocument.Bookmarks("Feature4").Range.Text = _
                         CStr(.Cells(lZeile, 10).Value)
                     
      'Anmerkung StokE:
      'Nachdem die Textmarken alle mit dem Inhalt der Exceltabelle gefüllt sind, soll jetzt der zweite Teil der Tabelle
      'drankommen bei dem jedesmal geprüft werden soll, ob ein "x" eingetragen ist.
      'Falls ja, soll der Text aus Zeile 2 in die Textmarke eingetragen werden.
      'Falls nein, soll nichts eingetragen werden und die nächste Spalte geprüft werden. Im original Dokument wären das
      'rund 15 Spalten die insgesamt geprüft werden.
      'Ich verstehe glaube ich wo das Problem liegt, aber mir fehlt das Wissen wie ich die If...then..else Prüfungen
      'logisch im Anschluss an die vorherigen Befehle die Textmarken auszufüllen anschließen kann.
      
      'Der Vorschlag von Gerhard H war folgender:
      
             'If CStr(.Cells(lZeile, 7).Value) = "x" Then
             'ActiveDocument.Bookmarks("Feature1").Range.Text = _
              'CStr(.Cells(2, 7).Value) 'Zeile 2
                'Else
             'ActiveDocument.Bookmarks("Feature1").Range.Text = ""
                'End If
      'Anmerkung Ende            
                   
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
       
         oExcelWorkbook.Close False
         oExcelApp.Quit
    
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If

   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub

Private Sub CommandButton2_Click()
     Unload Me
End Sub



Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
  
     'Zuerst wird die Excel Datei geöffnet
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
    
     ListBox1.Clear
     lZeile = 5 'Wir starten in Zeile 5, da in den ersten Zeilen Überschriften stehen
     With oExcelWorkbook.sheets(sTabellenblatt)
         Do While .Cells(lZeile, 2) <> ""
             ListBox1.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With
       
     oExcelWorkbook.Close False
     oExcelApp.Quit
      
   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub
Schonmal vielen Dank
StokE
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 06.10.2017, 00:15   #11
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo Stoke,

Zur Flexibilisierung des Pfades siehe die roten Zeilen im Vorspann und in der Userform_Initialize.
Anmerkung: Da das Makro im Word-Dokument steht, könnte es mit der Information ThisWorkbook.Path nichts anfangen. Das wäre richtig, wenn der Code in der BeispielTabelle.xlsl stehen würde.

Zum Eintrag der Features statt der "x" siehe die grünen und blauen Zeilen. Hier hab ich das für die ersten beiden Features erledigt. Der Rest geht nach demselben Strickmuster.


Code:

Option Explicit
' ************************************************************************************************
' Autor und Copyright: Marc Wershoven
' http://www.online-vba.de - E-Mail: info@online-vba.de
' ------------------------------------------------------------------------------------------------
' Wichtige Hinweise:
' - Verwendung der Quelltexte auf eigene Gefahr!
' - Bitte beachten Sie die Nutzungsbedingungen von www.online-vba.de!
' - Dieser Hinweis inkl. Autorennennung darf nicht entfernt werden!
' - Jede Weiterübermittlung, Veröffentlichung oder Verbreitung ist untersagt!
' - Eine kommerzielle/gewerbliche Verwendung ist nicht gestattet!
' ************************************************************************************************
' Diese Hinweise beziehen sich auf den Quelltext, wie dieser unter dem folgenden Link, unverändert
' als Original zu sehen ist und gelten nicht für Veränderungen durch Nutzer bzw. Dritte:
' www.online-vba.de/vba_tutorialvorlage.php
' ************************************************************************************************

'In dieser Konstanten speichern wir uns
'den Pfad und den Dateinamen der Adressliste (Excel)
'Bitte entsprechend anpassen!
'farbige Änderungen von Gerhard H
'Um den Speicherort zu flexibilisieren, machst du aus der Konstanten für die Mappe eine Variable:

Public sAdressDatei As String

'Private Const sAdressDatei As String = _
'     "F:tempstokeBeispielTabelle.xlsx"

'Wie heisst das Tabellenblatt, auf welchem sich die Adressen befinden?
'Bitte entsprechend anpassen!
Private Const sTabellenblatt As String = "Tabelle1"

Private Sub CommandButton1_Click()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
  
     'Nur wenn ein Eintrag in der Liste markiert ist, wird das Makro ausgeführt
     If ListBox1.ListIndex >= 0 Then
    
         'Zuerst wird die Excel Datei geöffnet
         Set oExcelApp = CreateObject("Excel.Application")
         Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)
    
         lZeile = 5 'Wir starten in Zeile 5, da in der ersten Zeilen überschriften stehen
         With oExcelWorkbook.sheets(sTabellenblatt)
             Do While .Cells(lZeile, 2) <> ""
                 'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
                 'übereinstimmt, dann werden die Textmarken gefüllt!
                 If ListBox1.Text = CStr(.Cells(lZeile, 2).Value) Then
                     'Eintrag gefunden, Textmarken füllen
                     ActiveDocument.Bookmarks("NameAuto").Range.Text = _
                         CStr(.Cells(lZeile, 2).Value)
                     ActiveDocument.Bookmarks("Typennummer").Range.Text = _
                         CStr(.Cells(lZeile, 3).Value)
                     ActiveDocument.Bookmarks("kw").Range.Text = _
                         CStr(.Cells(lZeile, 4).Value)
                     ActiveDocument.Bookmarks("PS").Range.Text = _
                         CStr(.Cells(lZeile, 5).Value)
                     ActiveDocument.Bookmarks("verfuegbar").Range.Text = _
                         CStr(.Cells(lZeile, 6).Value)
                     
                     'ab hier folgen die Einträge mit "x" bzw ohne "x"
                     'Ersetze bei JEDEM Feature die blauen auskommentierten Zeilen

'                     ActiveDocument.Bookmarks("Feature1").Range.Text = _
'                         CStr(.Cells(lZeile, 7).Value)

'                    durch diese grünen (dabei natürlich die Spaltennummern
'                    und die Feature-Nummern anpassen:)
                    If CStr(.Cells(lZeile, 7).Value) = "x" Then
                        ActiveDocument.Bookmarks("Feature1").Range.Text = _
                        CStr(.Cells(2, 7).Value) 'Zeile 2
                    Else
                     ActiveDocument.Bookmarks("Feature1").Range.Text = ""
                    End If
                    
'               ActiveDocument.Bookmarks("Feature2").Range.Text = _
'                         CStr(.Cells(lZeile, 8).Value)
                    If CStr(.Cells(lZeile, 8).Value) = "x" Then
                        ActiveDocument.Bookmarks("Feature2").Range.Text = _
                        CStr(.Cells(2, 8).Value) 'Zeile 2
                    Else
                     ActiveDocument.Bookmarks("Feature2").Range.Text = ""
                    End If
                    
                    'usw
                         
'                     ActiveDocument.Bookmarks("Feature3").Range.Text = _
'                         CStr(.Cells(lZeile, 9).Value)
'
'                     ActiveDocument.Bookmarks("Feature4").Range.Text = _
'                         CStr(.Cells(lZeile, 10).Value)
                     
                     Exit Do
                 End If
                 lZeile = lZeile + 1
             Loop
         End With
       
         oExcelWorkbook.Close False
         oExcelApp.Quit
    
     Else
         MsgBox "Bitte wählen Sie einen Eintrag aus der Liste aus!", _
             vbInformation + vbOKOnly, "HINWEIS!"
         Exit Sub
     End If

   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
   Unload Me
End Sub

Private Sub CommandButton2_Click()
     Unload Me
End Sub

Private Sub UserForm_Initialize()
   Dim oExcelApp As Object
   Dim oExcelWorkbook As Object
   Dim lZeile As Long
  
     'Zuerst wird die Excel Datei geöffnet
      sAdressDatei = ThisDocument.Path & "\BeispielTabelle.xlsx"
     Set oExcelApp = CreateObject("Excel.Application")
     Set oExcelWorkbook = oExcelApp.Workbooks.Open(sAdressDatei)

     ListBox1.Clear
     lZeile = 5 'Wir starten in Zeile 5, da in den ersten Zeilen Überschriften stehen
     With oExcelWorkbook.sheets(sTabellenblatt)
         Do While .Cells(lZeile, 2) <> ""
             ListBox1.AddItem CStr(.Cells(lZeile, 2).Value)
             lZeile = lZeile + 1
         Loop
     End With

     oExcelWorkbook.Close False
     oExcelApp.Quit

   Set oExcelWorkbook = Nothing
   Set oExcelApp = Nothing
End Sub

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.10.2017, 15:52   #12
StokE_182
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo,

kurze Rückmeldung: Mit eurer Hilfe funktioniert das Dokumentn jetzt wie gewünscht.
Habe mich jetzt doch dazu entschlossen das Dokument automatisch Speichern zu lassen (der Nutzer kann noch den Pfad aufwählen). Hat sich in der Praxis doch als praktisch herausgestellt.

Vielen Dank insbesondere an Gerhard H für die Hilfe.
StokE_182 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:04 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.