Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
628to632
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

word problem...

word problem...
30.06.2005 15:57:02
barbara
Hallo,
ja ,ja ich weiss hier sind die excel profis, aber da ihr mir schon so viel geholfen habt und ich in den word foren nicht so wirklich weiterkomm, hab ich dedacht probiers doch mal bei herber...
ich hab für mich ein unlösbares problem ( ich kann nämlich fast kein vba...)
also
rechnungsformular mit folgenden gewünschten sachen...
1. es soll eine fortlaufende rechnungsnummer generiert werden...
2. die datei soll via button automatisch in einen bestimmten ordner und unter einem autom. generiertem dateinamen jeweilige rgnummer und dem erstellungsdatum zu speichern sein
3. und eine übergabe an externe datei (wenn möglich in tabellenform) infos aus der rg wie z.b. rgdatum betrag etc.
ich hab das ganze in ähnlicher form im excel da läuft es ja wunnerbar, aber in word... ich weiss nicht...
ich weiss viele sachen aber ich komm leider alleine nicht weit...
gruß

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: word problem...
30.06.2005 16:07:10
Hajo_Zi
Hallo barbara,
vielleicht warst Du noch nicht in den richtigen. Ich habe ausgezeichnete Erfahrungen hier gemacht.
http://www.ms-office-forum.net/forum/forumdisplay.php?s=&daysprune=100&forumid=30
Beachte aber das Crossposting in keinem Forum gern gesehen wird.
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem Windows 2000 SP4 und Excel Version 2000 SP3.


Anzeige
AW: word problem...
30.06.2005 16:33:06
barbara
danke erstmal...
gruß
AW: word problem...
30.06.2005 20:08:40
barbara
Hilfe nochmal hajo bist du noch d ...
ich find nix oder ich bin zu blond das für mich umzusetzen - kann denn hier keiner einbisschen word...
biiiiiiiiiittttttttttttteeeeeeeeeeee hilfe
AW: word problem...
30.06.2005 20:28:59
Hajo_Zi
Hallo barbara,
ich bin nun nicht dr Wordfachmann. Ich lasse meine Probleme in dem von mir geposteteten Forum lösen. die Codeteile die ich hier poste wurden dort erstellt. Ich hoffe mal Dein Wissen in Word VBA ist besser als Excel VBA.
Folgende Ansätze
die Rechnungsnummer mußt Du über eine Textmarke mache, so jedenfalls meine Erfahrung. Die kann man leicht wieder auslesen. Mit folgenden Code werden alle Textmarken ausgelesen und Textboxen mit dem gleichen namen zugeordnet. Das bekommt man bestimmt umgestellt, das es Variablen zugeordnet wird.

For Each MyContr In Me.Controls     ' TextBox-Elemente herausfiltern
On Error Resume Next
If TypeOf MyContr Is MSForms.TextBox Then
Me.Controls(MyContr.Name).Text = ActiveDocument.Bookmarks(MyContr.Name).Range.Text
End If
Next

für das abspeichern hat Christian mir mal folgenden Code erstellt, was nartürlich nur ein Teil des Gesamtcode ist.
in einem Modul

'   Prüfen ob Netzwerkzugriff
If Dir("\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\") <> "" Then
Select Case UCase(Left(StOrt, 1))
Case "A", "B"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\A - B\"
Case "C", "D"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\C - D\"
Case "E", "F"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\E - F\"
Case "G", "H"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\G - H\"
Case "I", "J"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\I - J\"
Case "K", "L"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\K - L\"
Case "M", "N"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\M - N\"
Case "O", "P"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\O - P\"
Case "Q", "R", "S"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\Q - R - S\"
Case "T", "U"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\T - U\"
Case "V", "W"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\V - W\"
Case "X", "Y", "Z"
StPfad = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\X - Y - Z\"
Case Else
'               verzeichnis auswählen
StPfad = GetDirectory(StPfad)
GoTo Fehler1
End Select
StPfad2 = StPfad
'       erster Durchlauf feststellen des Ablage Phades und Nachfrage
'       feststellen ob der Ort vorhanden ist
StUnterpfad = Dir(StPfad & StOrt & "*", vbDirectory)
If StUnterpfad <> "" Then
StPfad = StPfad & StUnterpfad & "\"     ' vorhandener Ordner
Else
StPfad = StPfad & StOrt & "\"           ' neuer Ordner
End If
'       Angebotsnummer überprüfen
StUnterpfad = Dir(StPfad & StAngebotsnummer & "*", vbDirectory)
If StUnterpfad <> "" Then
StPfad = StPfad & StUnterpfad    ' Vorhandener Ordner
Else
StPfad = StPfad & StAngebotsnummer & " " & StKunde1
End If
'       Abfrage wegen Speicherort
FRM_Speichern.Lbl_Meldung.Caption = "Wollen Sie das Angebot hier " & Chr(13) & Chr(13) & _
StPfad & Chr(13) & "\Angebot_Text\" & StDateiname & ".DOC" & Chr(13) & Chr(13) & " speichern?"
FRM_Speichern.Lbl_Meldung.Tag = "1"
FRM_Speichern.Show                          'Abfrage Ordner anlegen
StPfad = StPfad & "\Angebot_Text\"

Folgender Code ist in de Userform FRM_Speichern mit zwei CommandButton. Es wird geprüft ob der Odner vorhanden ist und falls nicht wird er angelegt und ein Musterordner einschl. Struktur kopiert und benannt.

Option Explicit
Option Compare Text
'   von Christian MS-Office Forum
'   für anlegen Ordner
'   API FileCopy
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
(ByVal dwFlags As Long, lpSource As Any, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, _
Arguments As Long) As Long
Private Sub Cmd_Ja_Click()
If Lbl_Meldung.Tag = "1" Then
'       Ordner zurücksetzen und erneute Prüfung und anlegen
StPfad = StPfad2
'       Prüfen ob Ort vorhanden
StUnterpfad = Dir(StPfad & StOrt & "*", vbDirectory)
If StUnterpfad <> "" Then
StPfad = StPfad & StUnterpfad & "\"                 ' Ort vorhanden
Else
'           von Christian MS-Office Forum
fkt_MakeFolder StPfad & StOrt
StPfad = StPfad & StOrt & "\"
End If
'       Angebotsnummer überprüfen
StUnterpfad = Dir(StPfad & StAngebotsnummer & "*", vbDirectory)
If StUnterpfad <> "" Then
StPfad = StPfad & StUnterpfad & "\Angebot_Text\"    ' vorhandener Ordner
Else
'           von Christian MS-Office Forum
fkt_MakeFolder StPfad & StAngebotsnummer & " " & StKunde1
'           Zielordner
StPfad = StPfad & StAngebotsnummer & " " & StKunde1 ' neu: kein & "\"
'           Quellordner mit Unterordner und Dateien
StPfad2 = "\\Ntserver2\vertrieb\ANGEBOTE\Angebote ab 2003\05-30xxx Kunde"
'           neu: Kopieren mittels FSO
'           von Christian MS-Office Forum
Dim oFS As Object, ret As Variant
Set oFS = CreateObject("Scripting.FileSystemObject")
ret = oFS.CopyFolder(StPfad2, StPfad)
Set oFS = Nothing
StPfad = StPfad & "\Angebot_Text\"
End If
ActiveDocument.SaveAs (StPfad & StDateiname & ".doc")
Lbl_Meldung.Tag = ""
ElseIf Lbl_Meldung.Tag = "2" Then
ActiveDocument.SaveAs (StPfad & StDateiname & ".doc")
Lbl_Meldung.Tag = ""
End If
Me.Hide
End Sub
Private Sub Cmd_Nein_Click()
If Lbl_Meldung.Tag = "1" Then
'       Neuen Ordner wählen
StPfad = GetDirectory(StPfad)
Lbl_Meldung.Tag = ""
If StPfad <> "" Then ActiveDocument.SaveAs (StPfad & "\" & StDateiname)
ElseIf Lbl_Meldung.Tag = "2" Then
With Dialogs(wdDialogFileSaveAs)
.Name = StDateiname
.Show
End With
Lbl_Meldung.Tag = ""
End If
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'   Damit mit X nicht geschloßen werden kann
If CloseMode = 0 Then
MsgBox "Bitte schließen Sie die Anwendung mit der -Ende- Schaltfläche.", vbCritical
Cancel = 1
End If
End Sub
Function fkt_MakeFolder(ByVal sPath As String) As Boolean
'   erstellen eines Ordner
'   von Christian MS-Office Forum
'   dieser Code läuft
Dim Msg As String
If Dir(sPath, vbDirectory) = "" Then
MkDir (sPath)
If Err.Number > 0 Then
Msg = "Es ist ein Fehler beim Erstellen des Ordners aufgetreten!" & vbCrLf & sPath
MsgBox Msg & vbCrLf & Err.Description, vbCritical, "Ordner erstellen"
Err.Clear
fkt_MakeFolder = False
Exit Function
End If
End If
fkt_MakeFolder = True
On Error GoTo 0
End Function
Function fkt_FileCopy(strSource As String, strTarget As String) As String
'   Kopieren eines Ordner
'   von Christian MS-Office Forum
'   dieser Code läuft nicht
Dim Buffer As String
Dim ret As Long
Buffer = String(200, Chr(0))
'   Copy the selected file to our new directory
ret = CopyFile(strSource, strTarget, 0)
If ret = 0 Then
FormatMessage &H1000, ByVal 0&, GetLastError, &H0, Buffer, 200, ByVal 0&
fkt_FileCopy = Left(Buffer, InStr(1, Buffer, Chr(0)))
Else
fkt_FileCopy = "Kopieren erfolgreich"
End If
End Function

Das war mal jetzt ein wenig viel Code aber vieleicht findest Du Ansätze. Aber Fragen zu dem Code kann ich nur im geringen Umfang beantworten da ja Word.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige