Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Teil 4
Autor: Gekko
Datum: 19.09.04 17:39
'********************************************************************* ' Add & Remove custom properties to the open file. '********************************************************************* Private Sub cmdCustAdd_Click() Dim sName As String, sTmp As String Dim sValueText As String Dim vValue As Variant Dim lType As Long On Error Resume Next sName = txtCustName.Text sValueText = txtCustValue.Text ' We can't add a custom property unless we have a ' valid name and value. If ((sName = "") Or (sValueText = "")) Then Exit Sub ' Convert the Text string to a VARIANT of the type ' specified in the drop down list. lType = lstCustType.ListIndex + 1 Select Case lType Case 2 vValue = CLng(sValueText) Case 3 vValue = CDbl(sValueText) Case 4 vValue = CBool(sValueText) Case 5 vValue = CDate(sValueText) Case Else vValue = sValueText End Select ' Add the property... oDocProp.CustomProperties.Add sName, vValue If Err Then ' If an error occurs, it's most likely because the ' the property name already exists... MsgBox "The item could not be added:" & vbCrLf & Err.Description Err.Clear Else ' Add item to our list box... sTmp = sName & ": " & CStr(vValue) & " [" sTmp = sTmp & CustTypeName(lType) & "]" lstCustProps.AddItem sTmp txtCustName.Text = "" txtCustValue.Text = "" End If End Sub Private Sub cmdCustRemove_Click() Dim oRmProp As DSOleFile.CustomProperty Dim sName As String, sTmp As String On Error Resume Next sTmp = lstCustProps.List(lstCustProps.ListIndex) sName = Left(sTmp, InStr(sTmp, ":") - 1) ' Set a reference to the custom property we want and ' then call remove... Set oRmProp = oDocProp.CustomProperties.Item(sName) oRmProp.Remove Set oRmProp = Nothing lstCustProps.RemoveItem lstCustProps.ListIndex cmdCustRemove.Enabled = False End Sub Private Sub lstCustProps_GotFocus() If lstCustProps.ListCount <> 0 Then cmdCustRemove.Enabled = True End Sub Private Function CustTypeName(lType As Long) As String ' This function simply maps string names to the ' VARIANT type of a custom property. Select Case lType Case 1 CustTypeName = "String" Case 2 CustTypeName = "Long" Case 3 CustTypeName = "Double" Case 4 CustTypeName = "Boolean" Case 5 CustTypeName = "Date" Case Else CustTypeName = "Unknown" End Select End Function Private Sub EnableItems(bEnable As Boolean) txtTitle.Enabled = bEnable txtAuthor.Enabled = bEnable txtComments.Enabled = bEnable txtCustName.Enabled = bEnable txtCustValue.Enabled = bEnable lstCustType.Enabled = bEnable lstCustProps.Enabled = bEnable cmdCustAdd.Enabled = bEnable End Sub Vielen Dank nochmal Gekko

Wer kann mir dies übersetzen?	899	Gekko	19.09.04 17:32
Teil 2	682	Gekko	19.09.04 17:35
Teil 3	564	Gekko	19.09.04 17:38
Teil 4	577	Gekko	19.09.04 17:39
Re: Teil 4	541	eclere	20.09.04 12:07
Re: Teil 4	508	Lustlos	21.09.04 14:43

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen