Zeichenfolge zu lang
30.06.2014 15:00:04
Knoof
Ich möchte ein Formularfeld in Word per UserForm befüllen.
Allerdings hab ich erfahren dass man nicht mehr als 255 Zeichen an Word übergeben kann.
Ebenfalls hab ich erfahren dass es dafür eine Lösung gibt, ich konnte Sie bisher aber noch nicht umsetzen.
Es wäre nett wenn es jemand schafft meinen Quelltext so zu erweitern dass es klappt.
Danke.
Sub cmddruck_Click()
'Funktion: Erzeugt für Einträge in angegebener Zeile Serienbriefdrucke, abgelegt als einzelne _
Dateien im selben Ablageort wie Vorlagen-Datei
Dim ResultFile As String
Dim ErrorDesc As String
'Dim sbrief As String 'enthält Pfad der Serienbrief Vorlage
Dim WindowName As String 'wird zum Schließen von den geöffneten Quelldateien benötigt
Dim anrede As String, name As String, vorname As String
ResultFile = ActiveWindow.Caption '=Dateiname der Auszahlungsliste
Application.ScreenUpdating = False
' Inhalt = InputBox("Ab welcher Zeile sollen Serienbriefe (abwärts) erstellt werden? Bitte _
geben Sie die Zeilennummer an.")
' If Not IsNumeric(Inhalt) Or Inhalt = "" Then
' ErrorDesc = "Abbruch: Bitte geben Sie die Zeilennummer ein!"
' 'GoTo ENDE
' End If
' rowindex = Inhalt
'rowindex auf markierte zeile setzen
' rowindex = ActiveCell.Row 'nur bei einer markierten zeile!!
' rowindex = Selection.Rows.Address 'liest markierten BEREICH aus
'Prüfung, ob sbrief gefüllt, falls nicht wird "Set_LetterTemplate" ausgeführt
If sbrief = "" Then
Set_LetterTemplate
End If
'Schleife über markierte Zeilen
'Feldinhalte in Variablen einlesen
'anrede nname vname pinr vv anrede2 nname2 betrag monatjahr kinstitut kontonr blz
anrede = txtanrede
name = txtname
vorname = txtvorname
'/Schleife über markierte Zeilen
If LCase(anrede) = "Sehr geehrte" Then
anrede = "Frau"
Else
anrede = "Herr"
End If
On Error Resume Next
Set wdAnw = GetObject(, "Word.Application") 'Bestehende Word-Instanz suchen
Select Case Err.Number
Case 0 'OK
Case 429 'Es gibt soweit keine Word-Instanz
Err.Clear
Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
If Err.Number > 0 Then
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
Case Else 'Unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End Select
On Error GoTo 0
wdAnw.Visible = True 'Instanz sichtbar machen
wdAnw.WindowState = 0
'Je nach dem, ob das Dokument bereits geöffnet ist oder nicht wird verbunden
'bzw. geöffnet. Diese Differenzierung geschieht implizit.
On Error Resume Next
Set wdDok = wdAnw.Documents.Open(Filename:=sbrief)
If Err.Number > 0 Then 'Wenn Arbeitsmappe nicht existiert oder unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
On Error GoTo 0
'hier kommt das eigentliche Eintragen
wdAnw.ActiveDocument.Unprotect
With wdAnw.ActiveDocument.FormFields
.Item("anrede").Result = txtanrede
.Item("name").Result = txtname
.Item("vorname").Result = txtvorname
.Item("spanendes").Result = UserForm3.TextBox1.Value
End With
wdAnw.ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
BadOrHappyEnd Err.Number, Err.Description
'Dokument unter neuem Namen speichern - Word 97 doc format
Ersatzwort = Format(DateTime.Now, "yyyyMMdd_hh_mm_ss")
'wdAnw.ActiveDocument.SaveAs Filename:=sbrief & Ersatzwort & ".doc", _
' FileFormat:=wdFormatDocument97
pfad = wdDok.Path
wdAnw.ActiveDocument.SaveAs Filename:=pfad & "/" & monatjahr & "_" & nname & "_" & _
Ersatzwort & ".doc", _
FileFormat:=wdFormatDocument97
'Serienbrief Vorlage schliessen - ohne zu speichern
wdDok.Close SaveChanges:=wdDoNotSaveChanges
'Word App schliessen
Set wdDok = Nothing
wdAnw.Quit
Set wdAnw = Nothing
Application.ScreenUpdating = True
End Sub