Option VBASupport 1 
 
Rem ************************************************************************ 
Rem  Copyright 2005 - 2008 by René Holtz (http://www.rholtz-office.de)     * 
Rem ************************************************************************ 
 
Sub NummerWaehlenCalc() 
AusDreiMachEins StarDesktop.CurrentComponent.CurrentSelection().String 
End Sub 
 
Sub NummerWaehlenWriter() 
oDok = StarDesktop.getCurrentComponent() 
oViewCursor = oDok.getCurrentController().getViewCursor() 
oCur = oViewCursor.getText().createTextCursorByRange(oViewCursor) 
AusDreiMachEins oCur.getString() 
End Sub 
 

Option VBASupport 1 
 
Dim objShell As Object 
Dim myCall As Object 
Dim myDialog As Object 
Dim myImpressum As Object 
Dim txb1 As Object 
Dim txb2 As Object 
Dim txb3 As Object 
Dim txb4 As Object 
Dim mButton As Object 
Dim oButton As Object 
Dim lbl1 As Object 
Dim lbl2 As Object 
 
Sub ZellPruefungEin() 
Dim s As String 
mButton = myDialog.getControl("CommandButton3") 
lbl1 = myDialog.getControl("Label7") 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung") 
If s = "Aus" Then 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung", "Ein" 
Set objShell = Nothing 
Rem mButton.Model.Label = False 
mButton.Model.Label = "Gültigkeitsprüfung deaktivieren" 
lbl1.Model.Label = "Die Gültigkeitsprüfung ist aktiviert" 
Else 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung", "Aus" 
Set objShell = Nothing 
Rem mButton.Model.Label = False 
mButton.Model.Label = "Gültigkeitsprüfung aktivieren" 
lbl1.Model.Label = "Die Gültigkeitsprüfung ist deaktiviert" 
End If 
Set objShell = Nothing 
On Error GoTo 0 
End Sub 
 
Sub WarnerEin() 
Dim s As String 
oButton = myDialog.getControl("CommandButton5") 
pButton = myDialog.getControl("CommandButton6") 
lbl2 = myDialog.getControl("Label8") 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\Warner\0") 
If s = "Aus" Then 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\Warner\0", "Ein" 
lbl2.Model.Label = "Der 0190-Warner ist aktiviert" 
oButton.Model.Label = "0190-Warner deaktivieren" 
Else 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\Warner\0", "Aus" 
lbl2.Model.Label = "Der 0190-Warner ist deaktiviert" 
oButton.Model.Label = "0190-Warner aktivieren" 
End If 
Set objShell = Nothing 
On Error GoTo 0 
End Sub 
 
Sub DialogEin() 
Dim s As String 
Dim t As String 
Dialoglibraries.Loadlibrary ("Telefon") 
myDialog = CreateUnoDialog(Dialoglibraries.Telefon.CBCE) 
mButton = myDialog.getControl("CommandButton3") 
oButton = myDialog.getControl("CommandButton5") 
lbl1 = myDialog.getControl("Label7") 
lbl2 = myDialog.getControl("Label8") 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung") 
t = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\Warner\0") 
On Error GoTo 0 
Set objShell = Nothing 
If s = "Aus" Then 
lbl1.Model.Label = "Die Gültigkeitsprüfung ist deaktiviert" 
mButton.Model.Label = "Gültigkeitsprüfung aktivieren" 
Rem nButton.Model.Enabled = False 
Else 
lbl1.Model.Label = "Die Gültigkeitsprüfung ist aktiviert" 
mButton.Model.Label = "Gültigkeitsprüfung deaktivieren" 
Rem nButton.Model.Enabled = True 
End If 
If t = "Aus" Then 
lbl2.Model.Label = "Der 0190-Warner ist deaktiviert" 
oButton.Model.Label = "0190-Warner aktivieren" 
Else 
lbl2.Model.Label = "Der 0190-Warner ist aktiviert" 
oButton.Model.Label = "0190-Warner deaktivieren" 
End If 
myDialog.execute() 
End Sub 
 
Sub Information() 
Dialoglibraries.Loadlibrary ("Telefon") 
myImpressum = CreateUnoDialog(Dialoglibraries.Telefon.Impressum) 
myImpressum.execute() 
End Sub 
 
Sub FastCall() 
MsgBox "Noch nicht integriert", 48, "Hinweis" 
Rem Dialoglibraries.Loadlibrary("Telefon") 
Rem myCall= CreateUnoDialog(Dialoglibraries.Telefon.SWLA) 
Rem myCall.execute() 
End Sub 
 
Sub CallOut() 
txb4 = myCall.getControl("TextField1") 
AusDreiMachEins txb4.Model.Text 
myCall.endexecute() 
End Sub 
 
Sub ImpressumOut() 
myImpressum.endexecute() 
End Sub 
 
Sub CBC_Speichern() 
 
txb1 = myDialog.getControl("TextField1") 
txb2 = myDialog.getControl("TextField2") 
txb3 = myDialog.getControl("TextField3") 
 
Set objShell = CreateObject("WScript.Shell") 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCF", txb1.Model.Text 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCM", txb2.Model.Text 
objShell.RegWrite "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCA", txb3.Model.Text 
Set objShell = Nothing 
End Sub 

Option VBASupport 1 
 
Rem ************************************************************************************************************ 
Rem  Copyright 2005 - 2008 by René Holtz (http://www.rholtz-office.de)                                         * 
Rem ************************************************************************************************************ 
 
Declare Function tapiRequestMakeCall Lib "Tapi32.dll" (ByVal DestAddress As String, ByVal AppName As String, _
ByVal CalledParty As String, ByVal Comment As String) As Long 
 
Sub Telefonieren(TelefonNr$, derName$) 
Dim retval As Long 
retval = tapiRequestMakeCall(TelefonNr, "", derName, "") 
If retval <> 0 Then 
MsgBox "Beim Verbindungsaufbau ist ein Fehler aufgetreten!" 
End If 
End Sub 
 

Option VBASupport 1 
 
Rem ******************************************************************************************************************************************* 
Rem  Copyright 2005 - 2008 by René Holtz (http://www.rholtz-office.de)                                                                                    * 
Rem ******************************************************************************************************************************************* 
 
Rem ******************************************************************************************************************************************* 
Rem Beispielzeile für das Lesen, Schreiben und Löschen von Einträgen der Registrierungsdatenbank 
 
Rem Deklaration: Dim objShell As Object 
 
Rem Aus Registrierungsdatenbank lesen 
Rem objShell.RegRead ("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung") 
 
Rem In Registrierungsdatenbank schreiben: 
Rem objShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName", "Hase" 
 
Rem Aus Registrierungsdatenbank löschen: 
Rem objShell.RegDelete "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName" 
 
Rem Objectvariable freigeben mit: Set objShell = Nothing 
Rem ******************************************************************************************************************************************* 
 
Public Sub AusDreiMachEins(strt As String) 
Dim cancel As Boolean 
Dim i As Integer 
Dim s As String 
Dim objShell As Object 
 
If strt = "" Then GoTo Prüfpunkt 
 
Rem For i = Len(strt) To 1 Step -1 
Rem If Mid(strt, i, 1) = "(" And Left(strt, 1) = "+" And IsNumeric(Left(strt, 2)) Then 
Rem GoTo NummerWeiter 
Rem Exit For 
Rem End If 
Rem Next i 
 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\Prüfung") 
On Error GoTo 0 
Set objShell = Nothing 
If s = "Aus" Then GoTo ServicePrüfung 
If IsNumeric(strt) And Len(strt) > 5 And Left(strt, 1) = "0" And Not IsDate(strt) Then GoTo ServicePrüfung 
Prüfpunkt: 
MsgBox "Der Text entspricht keiner gültigen Telefonnummer.    " & Chr(13) & _
       "Der Vorgang wurde abgebrochen!!!   " & Chr(13) & _
       "Die Telefonnummer muss mindestens sechsstellig sein.  " & Chr(13) & Chr(13) & _
       "Bitte immer die Ortsvorwahl mit angeben !    " & Chr(13) & _
       "Bitte nur gültige Telefonnummern angeben!      " & Chr(13) & _
       "z.B. 0891234  oder  0049891234. " & Chr(13) & Chr(13), vbOKOnly, "Anwenderfehler !!!" 
Exit Sub 
 
ServicePrüfung: 
 
If Left(strt, 4) = "0800" Then GoTo NummerWeiter 
 
If Left(strt, 4) = "0190" Or Left(strt, 4) = "0180" _
Or Left(strt, 4) = "0137" Or Left(strt, 4) = "0900" _
Or Left(strt, 4) = "0136" Then GoTo ServiceWarnung 
 
If Left(strt, 3) = "010" Or Left(strt, 3) = "011" _
Or Left(strt, 3) = "012" Or Left(strt, 3) = "013" _
Or Left(strt, 3) = "014" Or Left(strt, 3) = "015" Then GoTo VorVorWahl 
 
ServiceRuf: 
 
If Left(strt, 2) = "00" Then GoTo AVW 'Prüfung Auslandsrufnummern 
 
Rem Prüfung Mobilfunkrufnummer (Deutschland) 
If Left(strt, 4) = "0151" Or Left(strt, 4) = "0152" _
Or Left(strt, 4) = "0159" Or Left(strt, 4) = "0160" _
Or Left(strt, 4) = "0162" Or Left(strt, 4) = "0163" _
Or Left(strt, 4) = "0170" Or Left(strt, 4) = "0171" _
Or Left(strt, 4) = "0172" Or Left(strt, 4) = "0173" _
Or Left(strt, 4) = "0174" Or Left(strt, 4) = "0175" _
Or Left(strt, 4) = "0176" Or Left(strt, 4) = "0177" _
Or Left(strt, 4) = "0178" Or Left(strt, 4) = "0179" Then GoTo AVV 
 
 
Rem Wahl Festnetzrufnummern 
NummerRichtig: 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCF") 
Set objShell = Nothing 
On Error GoTo 0 
A$ = s & strt 
Telefonieren A, "  " 
cancel = True 
Exit Sub 
 
Rem Wahl allgemeine Rufnummern (Service, 0800) 
NummerWeiter: 
A$ = strt 
Telefonieren A, "  " 
cancel = True 
Exit Sub 
 
Rem Wahl Auslandsrufnummern 
AVW: 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCA") 
Set objShell = Nothing 
On Error GoTo 0 
A$ = s & strt 
Telefonieren A, "  " 
cancel = True 
Exit Sub 
 
 
Rem Wahl Mobilfunkrufnummern 
AVV: 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\CBCM") 
Set objShell = Nothing 
On Error GoTo 0 
A$ = s & strt 
Telefonieren A, "  " 
cancel = True 
Exit Sub 
 
ServiceWarnung: 
On Error Resume Next 
Set objShell = CreateObject("WScript.Shell") 
s = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\Warner\0") 
Set objShell = Nothing 
On Error GoTo 0 
If s = "Aus" Then GoTo NummerWeiter 
If MsgBox("Sie versuchen, eine Servicenummer zu wählen.  " & Chr(13) & Chr(13) & _
          "Es könnte sich um eine teure Servicenummer handeln.  " & Chr(13) & Chr(13) & _
          "****** Möchten Sie dies wirklich? ******  " & Chr(13) & Chr(13) & _
          "Klicken Sie auf ja, wenn Sie die Nummer wählen möchten!  " & Chr(13) & Chr(13) & _
          "Klicken Sie auf nein, um den Vorgang abzubrechen!  ", 308, " *** Sicherheitsfrage *** ") = 6 Then GoTo NummerWeiter 
Exit Sub 
 
VorVorWahl: 
MsgBox "Sie haben versucht, eine Anbietervorwahl zu benutzen." & Chr(13) & _
       "Aus Sicherheitsgründen ist dies nicht erlaubt. Dadurch " & Chr(13) & _
       "wären die Sicherheitseinstellungen umgehbar." & Chr(13) & Chr(13) & _
       "***** Der Vorgang wurde abgebrochen *****", vbOKOnly + vbExclamation, "Sicherheitshinweis" 
Exit Sub 
ende: 
End Sub