Dokumentation: Projekt Kundenverwaltung (2009 - ) Modul: Infos

Details
Kategorie: Archivierte Beiträge
'Kundenverwaltung.odb Modul Infos
REM  *****  BASIC  *****

Sub Main

End Sub

REM  *****  BASIC  *****



SUB BenutzerDatenSystemAuslesen
' Benutzerdaten auslesen
    Dim Profil(0) as new com.sun.star.beans.PropertyValue
    Benutzer = createUnoService("com.sun.star.configuration.ConfigurationProvider")
    Profil(0).Name = "nodepath"
    Profil(0).Value = "org.openoffice.UserProfile/Data"
    Benutzerdaten = Benutzer.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", Profil())

'Definiere
    Firma = Benutzerdaten.o
    Vorname = Benutzerdaten.givenname
    Nachname = Benutzerdaten.sn
    Kuerzel = Benutzerdaten.initials
    Titel = Benutzerdaten.title
    Position = Benutzerdaten.position
    Telefon_gesch = Benutzerdaten.telephonenumber
    Fax = Benutzerdaten.facsimiletelephonenumber
    Telefon_privat = Benutzerdaten.homephone
    Email = Benutzerdaten.mail
    Strasse = Benutzerdaten.street
    PLZ = Benutzerdaten.postalcode
    Land = Benutzerdaten.c
    Ort = Benutzerdaten.l

' Benutzerdaten ausgeben
    MsgBox(Firma ,64,"Firma")
    MsgBox(Vorname ,64,"Vorname")
    MsgBox(Nachname ,64,"Nachname")
    MsgBox(Kuerzel ,64,"Kürzel")
    MsgBox(Titel ,64,"Titel")
    MsgBox(Position ,64,"Position")
    MsgBox(Telefon_gesch ,64,"Telefon, geschäftlich")
    MsgBox(Fax ,64,"Fax")
    MsgBox(Telefon_privat ,64,"Telefon, privat")
    MsgBox(Email ,64,"Email")
    MsgBox(Strasse ,64,"Straße")
    MsgBox(PLZ ,64,"PLZ")
    MsgBox(Land ,64,"Land")
    MsgBox(Ort ,64,"Ort")
END SUB

SUB DokumentenInfo_ermitteln
' Objekte deklarieren
    DIM Dokument AS OBJECT
    ' Aktuelles Dokument ansprechen
    Dokument = thisComponent
    ' Dokumenteigenschaften auslesen
    Autor = Dokument.DocumentInfo.Author
    Titel = Dokument.DocumentInfo.Title
    Thema = Dokument.DocumentInfo.Subject
    Schluesselwoerter = Dokument.DocumentInfo.Keywords
    Beschreibung = Dokument.DocumentInfo.Description
    ' Dokumenteigenschaften ausgeben
    MsgBox(Autor,64,"Autor des Dokuments")
    MsgBox(Titel,64,"Titel des Dokuments")
    MsgBox(Thema,64,"Thema des Dokuments")
    MsgBox(Schluesselwoerter,64,"Schlagworte des Dokuments")
    MsgBox(Beschreibung,64,"Beschreibung des Dokuments")
    
    ' Dateipfad ermitteln
    URL = Dokument.getURL()
    MsgBox(URL,64,"URL")
    ' Name und Wert der benutzerdefinierten Infofelder auslesen
    Name_Info1 = Dokument.DocumentInfo.getUserFieldName(0)
    Wert_Info1 = Dokument.DocumentInfo.getUserFieldValue(0)
    Name_Info2 = Dokument.DocumentInfo.getUserFieldName(1)
    Wert_Info2 = Dokument.DocumentInfo.getUserFieldValue(1)
    Name_Info3 = Dokument.DocumentInfo.getUserFieldName(2)
    Wert_Info3 = Dokument.DocumentInfo.getUserFieldValue(2)
    Name_Info4 = Dokument.DocumentInfo.getUserFieldName(3)
    Wert_Info4 = Dokument.DocumentInfo.getUserFieldValue(3)
    ' Name und Wert der benutzerdefinierten Infofelder ausgeben
    MsgBox(Name_Info1 & ": " & Wert_Info1,64,"Benutzerdefiniertes Infofeld 1")
    MsgBox(Name_Info2 & ": " & Wert_Info2,64,"Benutzerdefiniertes Infofeld 2")
    MsgBox(Name_Info3 & ": " & Wert_Info3,64,"Benutzerdefiniertes Infofeld 3")
    MsgBox(Name_Info4 & ": " & Wert_Info4,64,"Benutzerdefiniertes Infofeld 4")

    ' Dokumenteigenschaften ändern
    Dokument.DocumentInfo.Author = Autor
    Dokument.DocumentInfo.Title = Titel
    Dokument.DocumentInfo.Subject = Thema
    Dokument.DocumentInfo.Keywords = Schluesselwoerter
    Dokument.DocumentInfo.Description = Beschreibung
    ' Name und Wert der benutzerdefinierten Infofelder ändern
    Dokument.DocumentInfo.setUserFieldName(0,Name_Info1)
    Dokument.DocumentInfo.setUserFieldValue(0,Wert_Info1)
    Dokument.DocumentInfo.setUserFieldName(1,Name_Info2)
    Dokument.DocumentInfo.setUserFieldValue(1,Wert_Info2)
    Dokument.DocumentInfo.setUserFieldName(2,Name_Info3)
    Dokument.DocumentInfo.setUserFieldValue(2,Wert_Info3)
    Dokument.DocumentInfo.setUserFieldName(3,Name_Info4)
    Dokument.DocumentInfo.setUserFieldValue(3,Wert_Info4)
    ' Dokumententyp ermitteln
    IF Dokument.SupportsService("com.sun.star.text.TextDocument") THEN
      Dokutyp = "Textdokument"
    END IF
    
    IF Dokument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") THEN
      Dokutyp = "Tabellendokument"
    END IF
    
    IF Dokument.SupportsService("com.sun.star.presentation.PresentationDocument") THEN
      Dokutyp = "Präsentation"
    ELSE
      IF Dokument.SupportsService("com.sun.star.drawing.DrawingDocument") THEN
        Dokutyp = "Zeichnung"
      END IF
    END IF
    
    IF Dokument.SupportsService("com.sun.star.formula.FormulaProperties") THEN
      Dokutyp = "Formeldokument"
    END IF
END SUB

Sub GetFolderName(oRefModel as Object)
Dim oFolderDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim InitPath as String
Dim RefControlName as String
Dim oUcb as object
    'Note: The following services have to be called in the following order
    ' because otherwise Basic does not remove the FileDialog Service
    oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    InitPath = ConvertToUrl(oRefModel.Text)
    If InitPath = "" Then
        InitPath = GetPathSettings("Work")
    End If
    If oUcb.Exists(InitPath) Then
        oFolderDialog.SetDisplayDirectory(InitPath)
    End If
    iAccept = oFolderDialog.Execute()
    If iAccept = 1 Then
        sPath = oFolderDialog.GetDirectory()
        If oUcb.Exists(sPath) Then
            oRefModel.Text = ConvertFromUrl(sPath)
        End If
    End If
End Sub

Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String
Dim NoArgs() as New com.sun.star.beans.PropertyValue
Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
Dim oStoreDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim ListAny(0) as Long
Dim UIFilterName as String
Dim FilterName as String
Dim FilterIndex as Integer
    ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
    oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
    oStoreDialog.Initialize(ListAny())
    AddFiltersToDialog(FilterNames(), oStoreDialog)
    oStoreDialog.SetDisplayDirectory(DisplayDirectory)
    oStoreDialog.SetDefaultName(DefaultName)
    oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)

    iAccept = oStoreDialog.Execute()
    If iAccept = 1 Then
        sPath = oStoreDialog.Files(0)
        UIFilterName = oStoreDialog.GetCurrentFilter()
        FilterIndex = IndexInArray(UIFilterName, FilterNames())
        FilterName = FilterNames(FilterIndex,2)
        If Not IsMissing(iAddProcedure) Then
            Select Case iAddProcedure
                Case 1
                    CommitLastDocumentChanges(sPath)
            End Select
        End If
        On Local Error Goto NOSAVING
        If FilterName = ""  Then
            ' Todo: Catch the case that a document that has to be overwritten is writeprotected (e.g. it is open)
            oDocument.StoreAsUrl(sPath, NoArgs())
        Else
            oStoreProperties(0).Name = "FilterName"
            oStoreProperties(0).Value = FilterName
            oDocument.StoreAsUrl(sPath, oStoreProperties())
        End If
    End If
    oStoreDialog.dispose()
    StoreDocument() = sPath
    Exit Function
NOSAVING:
    If Err <> 0 Then
'        Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
        sPath = ""
        oStoreDialog.dispose()
        Resume NOERROR
        NOERROR:
    End If
End Function

Sub GetFileName(oRefModel as Object, Filternames())
Dim oFileDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim InitPath as String
Dim RefControlName as String
Dim oUcb as object
'Dim ListAny(0)
    'Note: The following services have to be called in the following order
    ' because otherwise Basic does not remove the FileDialog Service
    oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
    oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
    'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
    'oFileDialog.initialize(ListAny())
    AddFiltersToDialog(FilterNames(), oFileDialog)
    InitPath = ConvertToUrl(oRefModel.Text)
    If InitPath = "" Then
        InitPath = GetPathSettings("Work")
    End If
    If oUcb.Exists(InitPath) Then
        oFileDialog.SetDisplayDirectory(InitPath)
    End If
    iAccept = oFileDialog.Execute()
    If iAccept = 1 Then
        sPath = oFileDialog.Files(0)
        If oUcb.Exists(sPath) Then
            oRefModel.Text = ConvertFromUrl(sPath)
        End If
    End If
    oFileDialog.Dispose()
End Sub
Zugriffe: 308