AW: hmm...
26.11.2009 11:50:53
fcs
Moin Jörg,
da hab ich ich doch vergessen die Code-Schnippsel anzuhängen.
Hier erfolgt dann eine Namens-Prüfung, der Anwender entscheidet danach ob er/sie die Infos eingeben will.
Gruß
Franz
Private Sub Workbook_Open()
'Namen einlesen
If fncCheckName(ThisWorkbook, "Ausschreibung.Projekt") Then
'Name einlesen
ProjName = ThisWorkbook.Names("Ausschreibung.Projekt").Value
'Gleichheitszeichen und Anführungszeichen im NamensWert entfernen
ProjName = Mid(ProjName, 3, Len(ProjName) - 3)
End If
If fncCheckName(ThisWorkbook, "Ausschreibung.TP") Then
TPname = ThisWorkbook.Names("Ausschreibung.TP").Value
TPname = Mid(TPname, 3, Len(TPname) - 3)
End If
If ProjName "" And TPname "" Then
'Namen vorhanden
MsgBox "Projekt: " & ProjName & vbLf _
& "Teil-Projekt: " & TPname
Else
'Namen nicht/nicht vollständig vorhanden
If MsgBox("Namen für Projekt und/oder Teil-Projekt fehlen in der Datei" & vbLf _
& "Namen jetzt eingeben und anlegen?", vbQuestion + vbYesNo, _
"Ausschreibung-Dokumenet ersteleln") = vbYes Then
ProjName = InputBox("Projektname:", "Eingabe Projekt-Name", ProjName)
If ProjName "" Then
TPname = InputBox("Teilprojekt-Name:", "Eingabe Teilprojekt-Name", TPname)
If TPname "" Then
'Namen einfügen und Datei speichern
With ThisWorkbook
.Names.Add Name:="Ausschreibung.Projekt", RefersTo:="=""" & ProjName & """"
.Names.Add Name:="Ausschreibung.TP", RefersTo:="=""" & TPname & """"
.Save
End With
End If
End If
Else
Exit Sub
End If
End If
End Sub
Function fncCheckName(wb As Workbook, strName As String) As Boolean
'Prüft ob Namen in der Arbeitsmappe angelegt sind
Dim objName As Name
For Each objName In wb.Names
If LCase(objName.Name) = LCase(strName) Then fncCheckName = True: Exit Function
Next
End Function