Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Word Userform - Suchfeld für Worddateien - Ergebnisausgabe in Listbox

Frage Entwicklung VB for Applications

Mitglied: mreske

mreske (Level 1) - Jetzt verbinden

12.04.2014, aktualisiert 27.05.2014, 4382 Aufrufe, 21 Kommentare

Hallo,
ich habe ein Userform welches ich aus Word starte.
Das Userform greift u.a. auf Excel zu, um zb die Lieferantenadresse eines Lieferanten herauszufiltern.
Die in der Listbox ausgewählte Adresse wird dann an die entsprechenden Textmarken im Worddokument (Name, Anschrift, Ort etc) übergeben- so fülle ich also mit wenig Aufwand die Wordbestellung mit allen wichtigen Kopfdaten.

Jetzt möchte ich ebenfalls über ein Suchfeld Worddateien im Ordner "Q/Bestelltexte" finden und in einer Listbox auflisten.
Der Inhalt (Bestelltext) der ausgewählten Datei soll dann ebenfalls in das Worddokument übergeben werden.

Leider komme ich hier nicht weiter, weil "Application.FileSearch" bei Office 2007 nicht unterstützt wird.

Hier ein Sreenshot zur besseren Erklärung:
30f6710ac55fd9eefca9110cbb95a1b3 - Klicke auf das Bild, um es zu vergrößern

Hier der Code für das Suchfeld der Lieferanten:
01.
  
02.
Private Sub LiefSuche_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Change() 
03.
Set m_appExcel = Excel.Application 
04.
Set m_wbkExcel = Excel.Workbooks.Open("Q:\LiefStamm.xlsx") 
05.
Set m_wksExcel = Excel.Worksheets("LiefStamm") 
06.
Set m_rngExcel = m_wksExcel.UsedRange 
07.
    
08.
m_Suchwort = ("*" & BestelldatenWord.LiefSuche.Value & "*") 
09.
BestelldatenWord.LiefListBox.Clear 
10.
With m_wksExcel.Range("B:B") 
11.
Set m_rngExcel = .Find(m_Suchwort, LookIn:=xlValues, lookat:=xlWhole) 
12.
If Not m_rngExcel Is Nothing Then 
13.
m_strFirstAddress = m_rngExcel.Address 
14.
Do 
15.
With BestelldatenWord.LiefListBox 
16.
.ColumnCount = 1 '5 
17.
.AddItem 
18.
.List(.ListCount - 1, 0) = m_rngExcel.Text                   'LieferantenName 
19.
.List(.ListCount - 1, 1) = m_rngExcel.Offset(0, 1).Value     'LiefAnschrift 
20.
.List(.ListCount - 1, 2) = m_rngExcel.Offset(0, 2).Value     'LiefLand 
21.
.List(.ListCount - 1, 3) = m_rngExcel.Offset(0, 3).Value     'LiefPLZ 
22.
.List(.ListCount - 1, 4) = m_rngExcel.Offset(0, 4).Value     'LiefOrt 
23.
.ColumnWidths = "8cm" '5cm;1cm;2cm;3cm" 
24.
End With 
25.
Set m_rngExcel = .FindNext(m_rngExcel) 
26.
Loop While Not m_rngExcel Is Nothing And m_rngExcel.Address <> m_strFirstAddress 
27.
Else 
28.
End If 
29.
End With 
30.
m_wbkExcel.Close False 
31.
m_appExcel.Quit 
32.
Set m_appExcel = Nothing 
33.
End Sub 
34.
 
Vielleicht kann jemand helfen...
Danke vorab
Mitglied: colinardo
LÖSUNG 12.04.2014, aktualisiert 27.05.2014
Hallo mreske,
das könntest du so machen. In diesem Beispiel heißt das Textfeld in dem das Suchwort steht txtSearch und die Listbox lbResult. Der Ordner wird nach *.docx-Dateien durchsucht und bei einem Treffer des Suchwortes im Dateinamen der Pfad des Dokumentes der Listbox hinzugefügt. Bei einem Doppelklick auf einen Eintrag in der Listbox wird das entsprechende Word Dokument im Hintergrund geöffnet, der Text dessen extrahiert und dann an einer Textmarke(DeineTextmarke / noch anpassen) im aktuellen Dokument eingefügt.
01.
' Ordner für die Text-Vorlagen 
02.
Const DOCFOLDER = "Q:\Bestelltexte" 
03.
 
04.
Private Sub txtSearch_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
05.
    Dim doc As Document, fso As Object, file As Object 
06.
    'Inhalt der Listbox löschen 
07.
    lbResults.Clear 
08.
    Set fso = CreateObject("Scripting.FileSystemObject") 
09.
    For Each file In fso.GetFolder(DOCFOLDER).Files 
10.
        ' nur docx Dokumente durchsuchen 
11.
        If fso.GetExtensionName(file.Path) = "docx" Then 
12.
            If InStr(1, file.Name, txtSearch.Text, vbTextCompare) Then 
13.
                ' Wurde ein Treffer gefunden füge den Namen der Datei zur Listbox hinzu 
14.
                lbResults.AddItem file.Name 
15.
            End If 
16.
        End If 
17.
    Next 
18.
    Set fso = Nothing 
19.
End Sub 
20.
 
21.
Private Sub lbResults_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
22.
  If lbResults.ListIndex <> -1 Then 
23.
    Dim objWord As Word.Application, strDocPath As String, doc As Document 
24.
    'Neues Word-Objekt erzeugen damit das Dokument unsichtbar geöffnet werden kann 
25.
    Set objWord = New Word.Application 
26.
    objWord.Visible = False 
27.
    objWord.DisplayAlerts = False 
28.
     
29.
    ' Pfad der aktuell markierten Zeile holen 
30.
    strDocPath = lbResults.List(lbResults.ListIndex) 
31.
    'Word Dokument öffnen 
32.
    Set doc = objWord.Documents.Open(DOCFOLDER & "\" & strDocPath) 
33.
    'Inhalt mit Formaten kopieren 
34.
    doc.Content.Copy 
35.
     
36.
    ' Text an der Stelle einer Textmarke im aktuellen Dokument einfügen 
37.
    ActiveDocument.Bookmarks("DeineTextmarke").Range.Paste 
38.
     
39.
    doc.Close False 
40.
    objWord.DisplayAlerts = True 
41.
    objWord.Quit False 
42.
  End if 
43.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: mreske
12.04.2014 um 23:39 Uhr
Hallo Colinardo,
vielen Dank für die schnelle Antwort.
Leider bekomme ich eine Fehlermeldung weil die Variablen "FSO", "file" und "lbResults" nicht definiert sind.
Hier habe ich jetzt folgenden Code ergänzt:

Dim doc As Document
Dim FSO
Dim file
Dim lbResults as Object

Jetzt kommt zwar keine Fehlermeldung aber es passiert nach Verlassen des Textfeldes garnichts

Was mache ich falsch und wie muss ich die Variablen deklarieren?
Was muss ich ändern, damit in der Listbox nur die Dateinamen (ohne Pfad) angezeigt werden?

Vielen Dank vorab und noch einen schönen Abend
Bitte warten ..
Mitglied: colinardo
LÖSUNG 13.04.2014, aktualisiert 27.05.2014
Zitat von mreske:
Leider bekomme ich eine Fehlermeldung weil die Variablen "FSO", "file" und "lbResults" nicht
definiert sind.
Hier habe ich jetzt folgenden Code ergänzt:
OK dann hast du Option Explicit am Anfang deines Codesfensters stehen, habe es daraufhin angepasst.

Jetzt kommt zwar keine Fehlermeldung aber es passiert nach Verlassen des Textfeldes garnichts
Vermutlich stimmen die Namen der Listbox und des Suchfeldes noch nicht mit deinen Namen dieser Felder überein (lbResults darfst du nicht deklarieren das ist der Name des Steuerelementes deiner Listbox, wie bereits am Anfang geschrieben). Noch zur Sicherheit als Nachfrage: Willst du nach Dateinamen suchen, oder nach dem Inhalt in den Dateien? Im Moment sucht das Script nur in den Dateinamen! (Im Demo-Dokument das du weiter unten verlinkt findest ist aber eine auskommentierte Funktion enthalten mit der sich auch das realisieren ließe - wenn auch nicht sehr Performant.)

Was muss ich ändern, damit in der Listbox nur die Dateinamen (ohne Pfad) angezeigt werden?
ist oben angepasst. (Zeile 13: file.Name ist nur der Name der Datei) / Die Verfügbaren Eigenschaften des File-Objects kannst du hier nachlesen, und eine Referenz des FileSystemObjects hier.

Falls du jetzt immer noch nicht klar kommst, kannst du hier das DEMO-DOKUMENT dazu herunterladen. Im Demo-Dokument arbeite ich mit einer versteckten Spalte in der Listbox zum Speichern des Pfades für jeden Eintrag in der Listbox, damit ich nachher damit einfach das Dokument öffnen kann. Bitte den Pfad deiner Dokumente im Quelltext anpassen (ist im Moment auf "Q:\Bestelltexte" festgelegt und die Suche in diesem Ordner auf *.docx-Dateien festgelegt

Grüße Uwe
Bitte warten ..
Mitglied: mreske
13.04.2014 um 18:38 Uhr
Genial es funktioniert - genauso wie im Demo-Dokument habe ich es mir vorgestellt!

Leider wird die Einfügemarke "DeineTextmarke" überschrieben, d.h. dass das Marko bei einem zweiten Lauf einen Fehler ausgibt, weil er die Textmarke nicht findet.

ActiveDocument.Bookmarks("DeineTextmarke").Range.Paste ' --> beim 2. Lauf findet wird "DeineTextmarke" nicht gefunden.

Die anderen Textmarken (LiefName, LiefAnschrift, LiefPLZ etc) dagenen bleiben bestehen, wenn ich zb den Lieferanten über mein UserForm wechsel.
Liegt das evtl. daran, dass die Lieferanten-Adressdaten einzeilig sind und die Bestelltexte unterschiedlich lang (teilweise über mehrere Seiten)?

Gibt es nicht einen Schutz davor, dass die Textmarken gelöscht werden?

Grüße
Mreske
Bitte warten ..
Mitglied: colinardo
LÖSUNG 13.04.2014, aktualisiert 27.05.2014
Guckst du hier :
http://www.0711office.de/word/Bookmark.htm

Es gibt zwei Typen von Textmarken: Bereichs-Textmarken und Positions-Textmarken. Bei einer Positionstextmarke wir der Text hinter der Marke eingefügt, bei einer Bereichsmarke(die ich verwendet hatte) wird der ganze Bereich ersetzt und die Marke dabei gelöscht. Bei einer Bereichsmarke musst du dir also eine Referenz des Range speichern und nach dem Einfügen von Text in den Range erneut ein Bookmark über den Range via Code anlegen.
01.
Sub WriteInBookmark(ByVal sBookmarkName As String, _ 
02.
                                 ByVal sBookmarkText As String)  
03.
'Schreibt einen neuen Wert in ein vorhandenes Bookmark 
04.
  If ActiveDocument.Bookmarks.Exists(sBookmarkName) Then 
05.
    Dim r As Range 
06.
    Set r = ActiveDocument.Bookmarks(sBookmarkName).Range 
07.
    r.Text = sBookmarkText 
08.
    ActiveDocument.Bookmarks.Add sBookmarkName, r 
09.
  End If 
10.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: mreske
13.04.2014 um 22:27 Uhr
Hallo Uwe,
vielen Dank. Damit muss ich mich nächste Woche unbedingt beschäftigen. Wenn ich es mit den Textmarken hinbekommen habe, werde ich den Code online stellen.
Grüße
Manfred
Bitte warten ..
Mitglied: mreske
14.05.2014, aktualisiert um 23:01 Uhr
Hallo Uwe,
zwar etwas spät, aber ich möchte jetzt, wie versprochen die Prozedur online stellen:

01. Die Word-Datei "Breifbestellung.docm" und die Excel-Datei "Lieferanten.xls" bitte in folgendem Ordner ablegen: C:\vbaTest
02. Die Word-Dateien "Text1", Text2", Text3" bitte in diesem Ordner ablegen: C:\vbaTest\Bestelltexte
Hier können beliebig viele weitere Textdateien ergänzt werden
03. Mit ALT+F11 in die VBA-Umgebung wechseln und unter Extras-Verweise die Bibliothek anlegen: MicrosoftExcel xx.0 OjectLibary

Dann das Formular starten, Lieferanten suchen (Enter), Text suchen (Enter) und auf die Schaltfläche "Senden an Word" klicken

Bei mir läuft es einwandfrei
Leider bekomme ich es nicht hin, dass Word die Excel-Bibliothek automatisch lädt. Ich möchte damit vermeiden, dass auf anderen Rechnern immer erst manuell die Bibliothek geladen werden soll. Ich habe es mit LateBinding versucht aber ohne Erfolg - weiß da vielleicht jemand weiter?

Hier noch einmal der ganze Code:
01.
  
02.
Option Explicit 
03.
' Ordner für die Text-Vorlagen 
04.
 
05.
Const DOCFOLDER = "C:\vbaTest\Bestelltexte" 
06.
 
07.
Dim BoEnter As Boolean 
08.
Dim m_appExcel As Excel.Application 
09.
Dim m_wbkExcel As Excel.Workbook 
10.
Dim m_wksExcel As Excel.Worksheet 
11.
Dim m_rngExcel As Excel.Range 
12.
Dim m_rngCell As Range 
13.
Dim m_strFirstAddress As String 
14.
Dim m_Suchwort As String 
15.
Dim m_LiefName As String 
16.
Dim m_LiefAnschrift As String 
17.
Dim m_LiefLand As String 
18.
Dim m_LiefPLZ As String 
19.
Dim m_LiefOrt As String 
20.
Dim m_Bereich As Range 
21.
Dim m_rngDoc As Range 
22.
Dim m_oDoc As Document 
23.
Dim m_LT As String 
24.
 
25.
Private Sub UserForm_Initialize() 
26.
Dim DatumHeute As String 
27.
DatumHeute = Format(Date, "dd.mm.yyyy") 
28.
BestelldatenWord.BestDatum = DatumHeute 
29.
End Sub 
30.
 
31.
Private Sub BestelldatenWord_Activate() 
32.
lbResults.Clear 
33.
LiefSuche.SetFocus 
34.
End Sub 
35.
 
36.
Private Sub LiefSuche_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
37.
Set m_appExcel = Excel.Application 
38.
Set m_wbkExcel = Excel.Workbooks.Open("C:\vbaTest\Lieferanten.xlsx") 
39.
Set m_wksExcel = Excel.Worksheets("Lieferanten") 
40.
Set m_rngExcel = m_wksExcel.UsedRange 
41.
    
42.
m_Suchwort = ("*" & BestelldatenWord.LiefSuche.Value & "*") 
43.
BestelldatenWord.LiefListBox.Clear 
44.
With m_wksExcel.Range("F:F") 
45.
Set m_rngExcel = .Find(m_Suchwort, LookIn:=xlValues, lookat:=xlWhole) 
46.
If Not m_rngExcel Is Nothing Then 
47.
m_strFirstAddress = m_rngExcel.Address 
48.
 
49.
Do 
50.
With BestelldatenWord.LiefListBox 
51.
.ColumnCount = 1 
52.
.AddItem 
53.
.List(.ListCount - 1, 0) = m_rngExcel.Text                   'LieferantenName 
54.
.List(.ListCount - 1, 1) = m_rngExcel.Offset(0, 5).Value     'LiefAnschrift 
55.
.List(.ListCount - 1, 2) = m_rngExcel.Offset(0, 1).Value     'LiefLand 
56.
.List(.ListCount - 1, 3) = m_rngExcel.Offset(0, 6).Value     'LiefPLZ 
57.
.List(.ListCount - 1, 4) = m_rngExcel.Offset(0, 7).Value     'LiefOrt 
58.
.ColumnWidths = "8cm" 
59.
End With 
60.
 
61.
Set m_rngExcel = .FindNext(m_rngExcel) 
62.
Loop While Not m_rngExcel Is Nothing And m_rngExcel.Address <> m_strFirstAddress 
63.
Else 
64.
End If 
65.
End With 
66.
 
67.
m_wbkExcel.Close False 
68.
m_appExcel.Quit 
69.
Set m_appExcel = Nothing 
70.
End Sub 
71.
Private Sub LiefListBox_Click() 
72.
Set m_appExcel = Excel.Application 
73.
Set m_wbkExcel = Excel.Workbooks.Open("C:\vbaTest\Lieferanten.xlsx") 
74.
Set m_wksExcel = Excel.Worksheets("Lieferanten") 
75.
Set m_rngExcel = m_wksExcel.UsedRange 
76.
 
77.
Dim LiefKontakt As Worksheet 
78.
Dim EndeLiefKontakt As Integer 
79.
Dim I As Integer 
80.
Dim ZahlBed As String 
81.
 
82.
m_LiefName = LiefListBox.List(LiefListBox.ListIndex, 0) 
83.
m_LiefAnschrift = LiefListBox.List(LiefListBox.ListIndex, 1) 
84.
m_LiefLand = LiefListBox.List(LiefListBox.ListIndex, 2) 
85.
m_LiefPLZ = LiefListBox.List(LiefListBox.ListIndex, 3) 
86.
m_LiefOrt = LiefListBox.List(LiefListBox.ListIndex, 4) 
87.
 
88.
BestelldatenWord.LiefName = m_LiefName 
89.
BestelldatenWord.LiefAnschrift = m_LiefAnschrift 
90.
BestelldatenWord.LiefLand = m_LiefLand 
91.
BestelldatenWord.LiefPLZ = m_LiefPLZ 
92.
BestelldatenWord.LiefOrt = m_LiefOrt 
93.
 
94.
m_wbkExcel.Close False 
95.
m_appExcel.Quit 
96.
Set m_appExcel = Nothing 
97.
End Sub 
98.
 
99.
Private Sub SendenAnWord_Click() 
100.
Set m_Bereich = ActiveDocument.Bookmarks("LiefName").Range 
101.
m_Bereich.Text = m_LiefName 
102.
ActiveDocument.Bookmarks.Add Name:="LiefName", Range:=m_Bereich 
103.
 
104.
Set m_Bereich = ActiveDocument.Bookmarks("LiefAnschrift").Range 
105.
m_Bereich.Text = m_LiefAnschrift 
106.
ActiveDocument.Bookmarks.Add Name:="LiefAnschrift", Range:=m_Bereich 
107.
 
108.
Set m_Bereich = ActiveDocument.Bookmarks("LiefLand").Range 
109.
m_Bereich.Text = m_LiefLand 
110.
ActiveDocument.Bookmarks.Add Name:="LiefLand", Range:=m_Bereich 
111.
 
112.
Set m_Bereich = ActiveDocument.Bookmarks("LiefPLZ").Range 
113.
m_Bereich.Text = m_LiefPLZ 
114.
ActiveDocument.Bookmarks.Add Name:="LiefPLZ", Range:=m_Bereich 
115.
 
116.
Set m_Bereich = ActiveDocument.Bookmarks("LiefOrt").Range 
117.
m_Bereich.Text = m_LiefOrt 
118.
ActiveDocument.Bookmarks.Add Name:="LiefOrt", Range:=m_Bereich 
119.
 
120.
Set m_Bereich = ActiveDocument.Bookmarks("BestDatum").Range 
121.
m_Bereich.Text = BestelldatenWord.BestDatum 
122.
ActiveDocument.Bookmarks.Add Name:="BestDatum", Range:=m_Bereich 
123.
 
124.
Set m_Bereich = ActiveDocument.Bookmarks("LT").Range 
125.
m_Bereich.Text = BestelldatenWord.LT 
126.
ActiveDocument.Bookmarks.Add Name:="LT", Range:=m_Bereich 
127.
 
128.
BestelltextEinfügen 
129.
 
130.
Me.Hide 
131.
AlleFldAktualisieren 
132.
End Sub 
133.
 
134.
Sub BestelltextEinfügen() 
135.
If lbResults.ListIndex <> -1 Then 
136.
Dim objWord As Word.Application 
137.
Dim strDocPath As String 
138.
Dim docBestellung As Document 
139.
Dim docBestelltext As Document 
140.
 
141.
Dim strBMName   As String   'Textmarkenname 
142.
Dim rngBMRange  As Range    'Textmarkenbereich 
143.
   
144.
Dim strBMText   As String   'Textmarken-Text 
145.
strBMName = "Bestelltext1"  'Textmarkenname 
146.
 
147.
' Pfad der aktuell markierten Zeile aus der zweiten unsichtbaren Spalte holen 
148.
strDocPath = lbResults.List(lbResults.ListIndex, 1) 
149.
         
150.
Set docBestelltext = Documents.Open(strDocPath) 
151.
docBestelltext.Content.Copy 
152.
docBestelltext.Close True 
153.
 
154.
With ActiveDocument 'docBestellung 'ActiveDocument 
155.
If .Bookmarks.Exists(strBMName) Then 
156.
'Verweis auf den Textmarkenbereich setzen 
157.
Set rngBMRange = .Bookmarks(strBMName).Range 
158.
'Der Textmarke den Text zuweisen 
159.
rngBMRange.Paste 
160.
'Textmarke neu definieren 
161.
.Bookmarks.Add Name:=strBMName, Range:=rngBMRange 
162.
End If 
163.
End With 
164.
End If 
165.
End Sub 
166.
 
167.
Private Sub txtSearch_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
168.
Dim doc As Document, fso As Object, file As Object, found As Boolean 
169.
'Inhalt der Listbox löschen 
170.
lbResults.Clear 
171.
Set fso = CreateObject("Scripting.FileSystemObject") 
172.
For Each file In fso.GetFolder(DOCFOLDER).Files 
173.
' nur docx Dokumente durchsuchen 
174.
If fso.GetExtensionName(file.Path) = "docx" Then 
175.
If InStr(1, file.Name, txtSearch.Text, vbTextCompare) Then 
176.
found = True 
177.
'Wurde ein Treffer gefunden füge den Namen ohne Extension zur Listbox hinzu 
178.
lbResults.AddItem fso.GetBaseName(file.Name) 
179.
'Speichere den Pfad der Datei in einer zweiten Spalte der Listbox die in der Eigenschaft die Breite '0' bekommen sollte damit sie nicht sichtbar ist 
180.
lbResults.List(lbResults.ListCount - 1, 1) = file.Path 
181.
End If 
182.
End If 
183.
Next 
184.
If Not found Then 
185.
MsgBox "Kein Dokument mit dem Suchwort gefunden" 
186.
End If 
187.
End Sub 
188.
 
189.
Public Sub AlleFldAktualisieren() 
190.
Set m_oDoc = ActiveDocument 
191.
For Each m_rngDoc In m_oDoc.StoryRanges 
192.
m_rngDoc.Fields.Update 
193.
While Not (m_rngDoc.NextStoryRange Is Nothing) 
194.
Set m_rngDoc = m_rngDoc.NextStoryRange 
195.
m_rngDoc.Fields.Update 
196.
Wend 
197.
Next m_rngDoc 
198.
ActiveDocument.Bookmarks("LiefName").Select 
199.
End Sub
Bitte warten ..
Mitglied: mreske
14.05.2014 um 22:55 Uhr
Eigentlich wollte ich noch die Word und Excel Dateien hochladen, aber das scheint nicht zu gehen?
Bitte warten ..
Mitglied: colinardo
LÖSUNG 14.05.2014, aktualisiert 27.05.2014
n'Abend Manfred,
Ich habe es mit LateBinding versucht aber ohne Erfolg - weiß da vielleicht jemand weiter?
dazu tippst du folgendes in dein Dokument:
Set m_appExcel = CreateObject("Excel.Application")
Du musst dann aber jegliche Excel-Konstanten die du in deinem Code verwendest durch die tatsächlichen Werte ersetzen. D.h. z.B. solche wie xlUp, xlDown etc. pp., da diese ja ohne den Import des Verweises Word nicht bekannt sind! Dann klappt das auch ohne Verweis auf die Bibliothek.
Noch als Tipp wie du die tatsächlichen Werte der Konstanten erhältst: Dazu tippst du im VBA Editor von Excel in den Direktbereich debug.print gefolgt vom Namen der Konstanten ein und drückst Enter, und schon wird dir der tatsächliche Wert ausgeben.

Grüße Uwe
Bitte warten ..
Mitglied: colinardo
14.05.2014, aktualisiert um 23:06 Uhr
Zitat von mreske:
Eigentlich wollte ich noch die Word und Excel Dateien hochladen, aber das scheint nicht zu gehen?
die musst du leider selber irgendwo zum Download bereitstellen ... hier geht es leider nur mit Bildern.
Bitte warten ..
Mitglied: mreske
20.05.2014, aktualisiert um 21:58 Uhr
Vielen Dank Uwe,
ich werde es in den nächsten Tagen wohl erst ausprobieren können.

Erst möchte ich, dass die nun generierte Bestelldatei "Breifbestellung.docm" unter einen anderen Namen und in einem anderen Ordner abgespeichert wird.
Dazu soll sich ein "Speichern unter" Dialogfeld öffnen und den entsprechenden Pfad + Dateinamen voreinstellen.
Das funktioniert auch mit folgendem Code. Wenn ich aber den Button "Speichern" drücke, wird die Datei nicht im gewünschten Ordner abgespeichert (es passiert praktisch nichts). Ich habe schon alles ausprobiert und sämtliche Foren durchsucht, ohne Erfolg.

01.
Sub SpeichernMitBestellnummer() 
02.
Dim objWord As Word.Application 
03.
Dim Briefbestellung As Document 
04.
Dim dialogs As FileDialog 
05.
 
06.
m_PfadBestellung = "C:\vbaTest\Bestellungen\Bestellung1.docx" 
07.
 
08.
Set dialogs = Application.FileDialog(msoFileDialogSaveAs) 
09.
With dialogs 
10.
.InitialView = msoFileDialogViewList 
11.
.InitialFileName = m_PfadBestellung 
12.
.FilterIndex = 0 
13.
.Show 
14.
End With 
15.
End Sub
Beim folgenden Code wird zwar abgespeichert, aber der gewünschte Pfad und Dateiname ist nicht vorgegeben. Stattdessen zeigt das Dialogfeld den Pfad und Namen der Datei "Briefbestellung.docm" unter "C:\vbaTest\" an. Wenn ich hier den Pfad und Dateiname manuell eingebe, wird allerdings zumindest abgespeichert.

01.
ActiveDocument.Shapes(1).TextFrame.TextRange.Select 
02.
With dialogs(wdDialogFileSaveAs) 
03.
.Name = "C:\vbaTest\Bestellung1.docx" 
04.
.Show 
05.
End With
Warum wird die Datei nicht dort abgespeichert wo angegeben wurde?

Vielen Dank vorab
Bitte warten ..
Mitglied: colinardo
LÖSUNG 21.05.2014, aktualisiert 27.05.2014
Hallo Manfred,
der SaveAsDialog ist speziell und Objektabhängig. Deshalb solltest du diesen auch mit dem Word-Objekt erzeugen da du ja ein Word-Dokument und kein Excel-File speichern möchtest. Den Filterindex für das Format hast du ja schon richtig eingestellt. Dann musst du natürlich am Ende auch den Speichervorgang tatsächlich ausführen, was du mit .Execute machst. Zusätzlich sollte hier eine Abfrage geschehen ob der User wirklich den OK-Button und nicht den Abbrechen-Button gedrückt hat. Zusätzlich setze ich hier bei zu automatisierenden Aufgaben immer das DisplayAlerts = False damit eventuell erscheinende Popup-Warnungen nicht den Script-Ablauf stören. Hinterher bitte aber immer wieder auf True zurücksetzen.

Also insgesamt sieht das dann Beispielsweise so aus:
01.
    Dim objWord As New Word.Application, fd As FileDialog, doc As Word.Document 
02.
    objWord.DisplayAlerts = False 
03.
    Set doc = objWord.Documents.Open("C:\Pfad\demo.docm") 
04.
objWord.DisplayAlerts = True 
05.
    Set fd = objWord.FileDialog(msoFileDialogSaveAs) 
06.
    With fd 
07.
        .InitialView = msoFileDialogViewList  
08.
        .InitialFileName = "c:\Temp\SaveAs.docx" 
09.
        .AllowMultiSelect = False 
10.
        .FilterIndex = 0 
11.
        If .Show = True Then 
12.
            .Execute 
13.
        End If 
14.
    End With
Das Funktioniert in diversen Anwendungen die hier und beim Kunden laufen einwandfrei ...

Ich habe schon alles ausprobiert und sämtliche Foren durchsucht, ohne Erfolg.
Dann hast du vermutlich falsch gesucht, das Thema gibt's zig mal im Netz zu finden.

Viel Erfolg
Grüße Uwe
Bitte warten ..
Mitglied: mreske
21.05.2014 um 21:30 Uhr
Hallo Uwe,

erst mal vielen Dank für die schnellen Rückmeldungen.
Ich habe deinen Code jetzt so, wie oben beschrieben, eingegeben. Allerdings passiert das Gleiche wie vorher auch:

1. Das Dialogfeld "Speichern unter" den gewünschten Pfad + Dateiname korrekt an - speichert diesen aber nicht ab (wie schon zuvor beschrieben).
2, Nun erscheint ein weiteres Dialogfeld "Speichern unter" (wohl ausgeführt durch die .Execute Anweisung), jedoch mit dem Pfad und Dateinamen der Bestelldatei.
Wenn ich hier nun den Pfad und Dateiname manuell eingebe, wird die Datei abgespeichert.

Gruß
Manfred
Bitte warten ..
Mitglied: colinardo
LÖSUNG 21.05.2014, aktualisiert 27.05.2014
da muss bei dir irgendwas in deinem Code durcheinander gekommen sein, anders kann ich mir das nicht erklären. Hast du den Dialog auch wirklich aus dem Word-Objekt und nicht aus dem Excel-Application Objekt erzeugt ?
Hatte damit noch nie Probleme, irgendwo in deinem Code muss der Wurm drin sein, Schlaf nochmal drüber dann kommt dir sicher die Erleuchtung ...hatte ich hier schon oft
Bitte warten ..
Mitglied: mreske
22.05.2014, aktualisiert 26.05.2014
Hallo Uwe, ich glaube ich weiß jetzt wo der Fehler liegt:
Ich habe den Code aus der UserForm ausgeführt.
Ich muss ihn aber, glaube ich, aus einem Modul starten (und dann auch nicht mit F5 aus der UserForm starten, sondern im Word Register aus der Gruppe Makros aufrufen (ALT+F8).

Ich ändere das mal, sobald ich Zeit habe, und melde mich dann nochmal.

Manchmal ist es wirklich besser, auf die "Erleuchtung" am nächsten Tag zu warten.
Danke nochmal
Bitte warten ..
Mitglied: mreske
26.05.2014, aktualisiert um 21:25 Uhr
Hallo,
noch einmal zu meinem vorherigen Kommentar:
Ich habe es jetzt einmal bei der Arbeit unter Word 2010 getestet und hier läuft der Code einwandfrei, wenn ich ihn wie oben beschrieben aus einem Modul aus aufrufe.
Allerdings läuft es bei meiner Word 2007 Version (in Spanisch) zu Hause nach wie vor nicht, obwohl die Verweise in den Bibliotheken gleich sind. Hier öffnet sich zwar das Dialogfenster mit dem korrekt voreingestellten Pfad und Dateinamen aber nach klicken auf "Speichern" öffnet sich erneut das Dialogfenster mit dem Pfad und Namen des aktuellen Dokumentes. Es kann ja nicht sein, dass Word 2007 die "speichern unter" Funktion nicht unterstützt oder?

b39f6e640464bac403f44039e58e3e7f - Klicke auf das Bild, um es zu vergrößern
Bitte warten ..
Mitglied: colinardo
LÖSUNG 26.05.2014, aktualisiert 27.05.2014
Moin,
wenn du mit dem File zwischen unterschiedlichen Programmversionen hin und her wechselst musst du vor dem Ausführen einmal das vba projekt öffnen den Verweisdialog öffnen, und dann das Dokument nochmal abspeichern und schließen, sonst kann es Inkonsistenzen geben und es geschehen solche merkwürdigen Dinge. Deshalb arbeite ich ungerne mit solchen Verweisen, denn die benötigt man normalweise nicht wenn man die Objekte direkt über CreateObject erzeugt, aber das hatte ich ja bereits oben schon mal erwähnt.

Schönen Feierabend
Grüße Uwe
Bitte warten ..
Mitglied: mreske
26.05.2014, aktualisiert um 21:48 Uhr
Hallo Uwe,
genau davon lebt doch ein Forum oder? Die Zeit habe ich eigentlich auch nicht, ich nehme sie mir aber und verzichte dafür auf Anderes, in der Hoffung dazuzulernen.
Ich wechsel auch eigentlich nicht mit dem File zwischen den Programmversionen hin und her sondern aktualisiere jeweils nur die Prozeduren. Daher glaube ich nicht, dass es daran liegt.
Ich melde mich, wenn ich die Lösung gefunden habe.
Auch noch einen schönen Feierabend.
Bitte warten ..
Mitglied: colinardo
LÖSUNG 26.05.2014, aktualisiert 27.05.2014
Checke in der spanischen Version bitte auch ob der korrekte Filterindex selektiert ist, dort könnte der Eintrag für xlsx-Dateien an einer anderen Position stehen. Wenn das der Fall ist und du es universell gestallten willst, musst du die Filter mit einer Schleife durchlaufen und nach xlsx suchen. Du kannst mal testweise das DisplayAlerts = False rausnehmen, dann sollte dir eine Warnung angezeigt werden das Makros verloren gehen wenn du als xlsx abspeicherst.

Zur Info: Wenn du ein Dokument automatisiert speichern willst mit document.SaveAs(), unterdrücke mit DisplayAlerts = False eventuelle Dialoge. Arbeitest du aber mit dem SaveAs Dialog mit Userinput solltest du diese aber für diese Phase anzeigen und nicht unterdrücken lassen, damit gab es unter Office 2007 meine ich mal Probleme.

Naja ich habe hier schon sehr viel Geduld aufgebracht, dann wäre es auch von dir mal sehr nett wenn du deine Dokumente mal zur Verfügung stellen könntest (PM, e-Mail), damit wir das ganze hier schneller zu einem Abschluss bringen können ; Ansonsten klinke ich mich hier sonst aus.
Ich versuche hier zu helfen, aber da hilft meistens in solchen Fällen nur Fakten und keine schönen Worte.
Wenn ich immer die Glaskugel bemühen muss ist das ganze doch sehr mühselig. Du solltest mir mit dem Thema "Verweise" vertrauen, da ich das Thema bereits schon x mal beim Kunden hatte und dies nicht zu unterschätzen ist - auch wenn es nicht die Ursache sein sollte ist es unbedingt zu erwähnen !! Deswegen glaube mir und mach dein Dokument universeller, "ohne" zusätzliche Verweise...

Grüße Uwe
Bitte warten ..
Mitglied: mreske
27.05.2014 um 21:18 Uhr
Hallo Uwe,
ich habe die Lösung zum Problem gefunden.

Beim Starten von Word 2007 hat hier anscheinend ein Add-In Namens "AcerCloud Word Addin" versucht auf eine nicht vorhandene Registrierung zuzugreifen,

Hier die Vorgehensweise zur Korrektur:

01. Word OHNE Addins und Templates starten: Windows -> Start -> Ausführen mit: Winword.exe /a
02. Wenn das Marko hier läuft, muss herausgefunden werden, welche Addins existieren (siehe Punkt 03).
03. In Word auf die Office-Schaltfläche -> Word-Optionen -> Anpassen -> im rechten Bereich der Liste "Alle Befehle" auswählen" -> COM-Add-ins HINZUFÜGEN
Somit kann man dann über eine Schaltfläche im Menu die Addins anzeigen lassen
0a406fd3a345c54498c602bb36964a1f - Klicke auf das Bild, um es zu vergrößern

01c27e7b9823cddf9a2eb018b48858fb - Klicke auf das Bild, um es zu vergrößern

Alternativ kann man aus folgenden Code ausführen und sich die Addins per Msgbox anzeigen lassen:
01.
Sub ListAddins() 
02.
   Dim MyAddin As COMAddIn 
03.
   Dim i As Integer, msg As String 
04.
 
05.
   For Each MyAddin In Application.COMAddIns 
06.
      msg = msg & MyAddin.Description & " - " & MyAddin.ProgID & vbCrLf 
07.
   Next 
08.
   MsgBox msg 
09.
End Sub
04. Dann das entsprechende Addin löschen
6852ac3f4c8267c506adc8b906de3f4f - Klicke auf das Bild, um es zu vergrößern

Jetzt läuft die "Speichern unter" Prozedur perfekt. Vielleicht hat ja mal jemand das gleiche nervtötende Problem.

Ich möchte den Beitrag jetzt abschließen. Vielen Dank für deine Hilfe und Geduld Uwe. Im Gegensatz zu deinen Kenntnissen bin ich ja noch Anfänger. Ich werde deine Ratschläge bezüglich der Verweise anschauen und ggf. hier aktualisieren. Die Beispieldateien verlinke ich demnächst auch hier im Forum.

Viele Grüße
Bitte warten ..
Mitglied: colinardo
27.05.2014, aktualisiert um 23:58 Uhr
Oh man, jetzt wo du "Acer" sagst fällt es mir wie Schuppen von dem Augen. Hatte genau das Problem vor ca. 2 Monaten bei jemandem dem ich hier auch geholfen habe und mich dann via Teamviewer aufschalten musste, aber mir viel ums verrecken nicht mehr ein was die Fehlerursache war. Genau dieses Schrott-Acer-Cloud-Addin hat bei demjenigen auch besagtes Verhalten ausgelöst, ich danke dir sehr das du es in eine Ausführliche Anleitung verpackt hast
Das wird sicherlich so manchem viel Frust ersparen ...

Viel Erfolg weiterhin
Grüße Uwe
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
gelöst Wie kann man die Standard-Schriftart bei einfügen von Text in Word 2013 festlegen? (3)

Frage von Rene1976 zum Thema Microsoft Office ...

Microsoft Office
Rechnungen in Word - zu lange Formel (2)

Frage von traller zum Thema Microsoft Office ...

Windows Server
gelöst Word 2010 : Absatz - Abstand per GPO ändern (3)

Frage von johanna-p zum Thema Windows Server ...

Microsoft Office
Absätze und Umbrüche in Word machen sich selbständig (17)

Frage von BeSt zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...