Hallo Leute !
Erstmal Danke für Eure Antworten ! Bevor es jemand probiert :
Die Sache mit der Textüberschreibung funzt net...
Die Sache mit dem benutzerdef. parameter funzt nur für ein Blatt....
Meine Lösung funzt für alle Blätter (Haken : Wert wird nur beim Speichern des Docs gesetzt)
Und hier ist sie (Dokumentenprojekt,eine angeforderte Eingabe "D_Format" ist erforderlich) :
Public Sub AutoSave()
'Setzt den Wert für eine angeforderte Eingabe für DIN Format (nur Zahl) beim Speichern
Dim oDrawDoc As DrawingDocument
Dim adoctype As Long
adoctype = ThisApplication.ActiveDocument.DocumentType
If adoctype <> 12292 Then Exit Sub
Set oDrawDoc = ThisApplication.ActiveDocument
Dim DINA As String
DINA = oDrawDoc.ActiveSheet.Size
Dim DIN_F As Long
Debug.Print DINA
Select Case DINA
Dim Blattgroesse As String
Case 9993
DIN_F = 0
Case 9994
DIN_F = 1
Case 9995
DIN_F = 2
Case 9996
DIN_F = 3
Case 9997
DIN_F = 4
Case Else
DIN_F = "?"
End Select
Dim aBlatt As Sheet
Set aBlatt = oDrawDoc.ActiveSheet
'Aktualisieren Schriftfeld
Dim SFeld As TitleBlock
Set SFeld = oDrawDoc.ActiveSheet.TitleBlock
Dim SFeldname As String
SFeldname = SFeld.Definition.Name
Dim TBoxes As TextBoxes
Set TBoxes = oDrawDoc.TitleBlockDefinitions(SFeldname).Sketch.TextBoxes
Dim FBox As TextBox
Dim i As Long
i = 1
'For i = 1 To TBoxes.Count
Set FBox = TBoxes.Item(i)
Do Until FBox.Text = "D_Format"
Set FBox = TBoxes.Item(i)
Debug.Print FBox.Text & "Index" & i
i = i + 1
Loop
'Next i
'Set FBox = TBoxes.Item(42)
SFeld.SetPromptResultText FBox, DIN_F
Set aBlatt = Nothing
Set TBox = Nothing
Set oDrawDoc = Nothing
End Sub
SCHÖNE FEIERTAGE !!! 
------------------
Gruß TSch
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
