Replace in OOo

[mumpel]

Hallo!

In OOo habe ich ein Problem mit Replace. Per Code übergebe ich einen String. Jetzt sollen zum Beispiel alle Klammern aus diesem entfernt werden. OOo entfernt, anders als VBA, aber nur eines der angegebenen Zeichen anstatt aller. Sind Zum Beispiel zwei öffnende Klammern enthalten, wird nur eine entfernt. VBA dagegen entfernt alle beide Klammern, so wie es sein soll.

Hier ein Beispielcode. So ähnlich sieht er aus (in OOo-Starbasic).

Sub NummerWaehlenCalc()
NummerUebergeben StarDesktop.CurrentComponent.CurrentSelection().String
End Sub

Sub NummerUebergeben(strT As String)
Dim ST As String
Rem Der Wert "ST" wird der
Rem Registry entnommen
On Error Resume Next
Set objShell = CreateObject("WScript.Shell")
ST = objShell.RegRead("HKEY_CURRENT_USER\Software\VB and VBA Program Settings\RMH_Installationen\w2007\STKenn")
On Error GoTo 0
Set objShell = Nothing
strT = Replace(strT, "_", " ")
strT = Replace(strT, "<", " ")
strT = Replace(strT, ">", " ")
strT = Replace(strT, "[", " ")
strT = Replace(strT, "]", " ")
strT = Replace(strT, "~", " ")
strT = Replace(strT, "*", " ")
strT = Replace(strT, "#", " ")
strT = Replace(strT, "\", " ")
strT = Replace(strT, "/", " ")
strT = Replace(strT, "-", " ")
strT = Replace(strT, "(", " ")
strT = Replace(strT, ")", " ")
If ST = "DE" And Left(strT, 3) = "+49" Then
strT = Replace(strT, "+49", "0")
ElseIf ST = "AT" And Left(strT, 3) = "+43" Then
strT = Replace(strT, "+43", "0")
ElseIf ST = "CH" And Left(strT, 3) = "+41" Then
strT = Replace(strT, "+42", "0")
End If
MsgBox strT
End Sub

Code eingefügt mit VBA in HTML 2.0

Wie bringe ich OOo dazu, alle entsprechenden Zeichen aus dem übergebenen String zu entfernen? Danke!

Gruß, René

[Charly]

Hallo Mumpel!

Den Befehl Replace kenne ich so nicht in Starbasic. Ich kenne nur einen ReplaceDescriptor. Der Aufruf dafür geht wie folgt:

Code: Alles auswählen

Sub Suchen_Ersetzen() 

Doc = ThisComponent 
Zelle = Doc.CurrentSelection()

Ersetzen = Zelle.createReplaceDescriptor() 


Ersetzen.ReplaceString = "" 

Ersetzen.SearchString = "_"
Zelle.ReplaceAll(Ersetzen) 

Ersetzen.SearchString = "<"
Zelle.ReplaceAll(Ersetzen) 

Ersetzen.SearchString = ">"
Zelle.ReplaceAll(Ersetzen)

Ersetzen.SearchString = "["
Zelle.ReplaceAll(Ersetzen)  

Ersetzen.SearchString = "]"
Zelle.ReplaceAll(Ersetzen)  

Ersetzen.SearchString = "~"
Zelle.ReplaceAll(Ersetzen)  

Ersetzen.SearchString = "*"
Zelle.ReplaceAll(Ersetzen)

Ersetzen.SearchString = "#"
Zelle.ReplaceAll(Ersetzen)   

Ersetzen.SearchString = "\"
Zelle.ReplaceAll(Ersetzen) 

Ersetzen.SearchString = "/"
Zelle.ReplaceAll(Ersetzen)   

Ersetzen.SearchString = "-"
Zelle.ReplaceAll(Ersetzen)

Ersetzen.SearchString = "("
Zelle.ReplaceAll(Ersetzen) 

Ersetzen.SearchString = ")"
Zelle.ReplaceAll(Ersetzen)      



End Sub 

Mit Hilfe von regulären Ausdrücken kann man sicherlich den Code noch verkürzen. Ich kenne mich nur damit nicht sogut aus und wiederhole daher den Such- und Ersetzbefehl für alle Zeichen.


Gruß
Charly

[mumpel]

Danke, aber das nützt mir in diesem Fall nichts. Es soll nicht der Wert in der Zelle gesäubert werden, sondern nur der übergeben Wert. Um zu verdeutlichen, was ich meine, hänge ich mal den ganzen Code (hier aus Excel) an. Ohne die Replacefunktion funktioniert es auch in OOo problemlos. Die Replacefunktion habe ich aber erst vor ein paar Tagen in Excel eingebaut. Ich bin mir ziemlich sicher, dass es diese Replacefunktion auch in OOo-Starbasic gibt, nur muss man es anders programmieren.

Code: Alles auswählen

Option Private Module
Option Explicit

Declare Function tapiRequestMakeCall Lib "Tapi32.dll" (ByVal DestAddress As String, _
ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As Long
Public A$

Sub Telefonieren(TelefonNr$, derName$)
Application.EnableCancelKey = False
Dim retval As Long
retval = tapiRequestMakeCall(TelefonNr, "", derName, "")
If retval <> 0 Then
MsgBox "Beim Verbindungsaufbau ist ein Fehler aufgetreten!"
End If
End Sub

Sub WählHilfeAufrufen(control As IRibbonControl)
NummerAnWählhilfeÜbergeben ActiveCell.Value, "   "
End Sub

Sub NummerSenden()
NummerAnWählhilfeÜbergeben ActiveCell.Value, "   "
End Sub

Sub BoxWahlRaus(control As IRibbonControl, ByRef Rufnummer)
Dim Eingabe As String
Eingabe = Rufnummer
NummerAnWählhilfeÜbergeben Eingabe, "   "
End Sub

Public Sub NummerAnWählhilfeÜbergeben(strT As String, Name As String)
Application.EnableCancelKey = False
Dim cancel As Boolean
Dim i As Integer
Dim s As String
Dim ST As String

If strT = "" Then GoTo Prüfpunkt

Rem Ersetzen von Sonderzeichen in zu wählenden Rufnummern
Rem "ST" = Auslesen der Länderkennung (in Registry gespeichert)
ST = GetSetting("RMH_Installationen", "w2007", "STKenn")

strT = Replace(strT, "_", " ")
strT = Replace(strT, "<", " ")
strT = Replace(strT, ">", " ")
strT = Replace(strT, "[", " ")
strT = Replace(strT, "]", " ")
strT = Replace(strT, "~", " ")
strT = Replace(strT, "*", " ")
strT = Replace(strT, "#", " ")
strT = Replace(strT, "\", " ")
strT = Replace(strT, "/", " ")
strT = Replace(strT, "-", " ")
strT = Replace(strT, "(", " ")
strT = Replace(strT, ")", " ")
If ST = "DE" And Left(strT, 3) = "+49" Then
  strT = Replace(strT, "+49", "0")
ElseIf ST = "AT" And Left(strT, 3) = "+43" Then
  strT = Replace(strT, "+43", "0")
ElseIf ST = "CH" And Left(strT, 3) = "+42" Then
  strT = Replace(strT, "+42", "0")
End If

Rem "s" = Auslesen der Einstellung für Gültigkeitsprüfung (in Registry gespeichert)
s = GetSetting("RMH_Installationen", "Pruefung", "2")
If s = "0" Then GoTo VorwahlPrüfung

If Left(strT, 1) = "+" Then
  strT = Replace(strT, "+", "00 ")
  GoTo VorwahlPrüfung
End If

strT = Replace(strT, " ", "")

Rem Ende Ersetzen

Rem Beginn Gültigkeitsprüfung
For i = Len(strT) To 1 Step -1
If IsNumeric(strT) And Len(strT) > 5 And Left(strT, 1) = "0" And Not IsDate(strT) Then GoTo VorwahlPrüfung
Next i
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 +43(1)1234567. " & Chr(13) & _
       " " & Chr(13) & Chr(13), vbOKOnly, "Anwenderfehler !!!"
Exit Sub
Rem Ende Güligkeitsprüfung

Rem Beginn Vorwahlprüfung
VorwahlPrüfung:
strT = Replace(strT, "R", "")
If Left(strT, 4) = "0800" Then GoTo NummerServicedienste

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 AnbieterVorwahl

If Left(strT, 2) = "00" Then GoTo NummerAusland

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 NummerMobilfunkInland
Rem Ende Vorwahlprüfung

Rem Beginn Wahlvorgang einleiten

Rem Wählen Festnetznummern Inland
Rem Definierte Anbietervorwahl für Festnetz wird
Rem automatisch vorangestellt
NummerFestnetzInland:
A$ = GetSetting("RMH_Installationen", "w2007", "CBCF") & strT
Telefonieren A, Name
cancel = True
Exit Sub

Rem Wählen Telefonnummern Ausland
Rem Definierte Anbietervorwahl für Auslandsgespräche wird
Rem automatisch vorangestellt
NummerAusland:
If GetSetting("RMH_Installationen", "w2007", "CBCA") = "" Then
A$ = strT
Else
A$ = GetSetting("RMH_Installationen", "w2007", "CBCA") & " " & strT
End If
Telefonieren A, Name
cancel = True
Exit Sub

Rem Wählen Mobilfunknummern Inland
Rem Definierte Anbietervorwahl für Mobilfunk wird
Rem automatisch vorangestellt
NummerMobilfunkInland:
A$ = GetSetting("RMH_Installationen", "w2007", "CBCM") & strT
Telefonieren A, Name
cancel = True
Exit Sub

Rem Wählen von Sonderrufnummern (Call By Call wird nicht berücksichtigt)
NummerServicedienste:
A$ = strT
Telefonieren A, Name
cancel = True
Exit Sub

Rem Ende Wahlvorgang einleiten

Rem Beginn Meldung 0190-Warner
ServiceWarnung:
Rem Auslesen der Einstellung für 0190-Warner (in Registry gespeichert)
If GetSetting("RMH_Installationen", "Warner", "2") = "0" Then GoTo NummerServicedienste
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 NummerServicedienste
Exit Sub
Rem Ende Meldung 0190-Warner

Rem Beginn Meldung Anbietervorwahl
AnbieterVorwahl:
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
Rem Ende Meldung Anbietervorwahl

Ende:
End Sub

Ich hänge auch mal das Projekt für OOo an, um welches es geht. Mit diesem ist es möglich, Telefonnummern in einer Zelle (Excel, OOo-Calc) oder eine markierte Nummer in Dokumenten (Word/OOo-Writer) zu wählen. In dem aktuellen Projekt gibt es die Replacefunktion noch nicht. Diese ist aber erforderlich, um auch das internationale Format ( +43(1)123456 ) nutzen zu können. Dieses muss aber bereinigt werden, damit daraus 00 43 1 123456 wird. Nur so wird die Telefonnummer von der Wählhilfe korrekt umgesetzt und die Anbietervorwahl nutzbar.

[Charly]

Hallo Mumpel!

Ich kenne leider keine Replace-Funktion in dieser Form in Starbasic. Sollte es wirklich keine geben, kann man sich diese aber relativ einfach selbst programmieren.

Code: Alles auswählen

Sub Test

Doc = ThisComponent
Zelle = Doc.CurrentSelection
Nr = Zelle.string
NrNeu = Replace(Nr)
MSGBox(NrNeu)
End Sub


Function Replace(StrT)

Erg = ""
Laenge = Len(StrT)
For I = 1 To Laenge

Zeichen = Mid(StrT,I,1)

Select Case Zeichen

Case "[","]","~","*", "#","\","/","-","(",")"

Case Else
Erg= Erg + Zeichen

end select
next
Replace = Erg
End Function

Vielleich kannst du damit leben.

Gruß Charly

[mumpel]

Funktioniert auch nicht, wie es soll. Bei Auslandsrufnummern sollen Leerzeichen rein. Aus +43(1)12345 muss 00 1 12345 werden. Die Leerzeichen bei Auslandsrufnummern sind zwingend erforderlich, wie ich bereits erwähnte. Es muss absolut genau so funktionieren, wie in Excel. So wie es aussieht, muss ich mein Vorhaben wohl begraben. OOo eben.

[Stephan]

So wie es aussieht, muss ich mein Vorhaben wohl begraben.

Und wieso?
Charly hat Dir eine Lösung für replace genannt, die du lediglich in DEine Lösung integrieren und um die nötigen Dinge für die Auslandsvorwahl ergänzen müßtest.

Sorry, nur ich bin immer wieder erstaunt wie wenig Ausdauer Du zeigst - wo ich doch genau weiß das Du für ein Experte in VBA bist, ist mir einfach unklar warum Du bei StarBasic bei kleinsten Schwierigkeiten immer alles gleich zur Seite legst.
Hat eigenlich auch nichts mit VBA vs. StarBasic oder MS Office vs. OOo zu tun, gilt generell fürs Programmieren. Ich weiß garnicht wieviele Wochen ich in meinem Leben schon insgesamt gebraucht habe (sei es VBA, sei es StarBasic, sei es VB6 oder .Net, sei es Delphi oder was immer) um hartnäckig nach Lösungen zu suchen. Das hierzu Ausdauer nötig ist ist unbestritten, nur es ist ein Teil dessen was es ausmacht zu programmieren.



Gruß
Stephan

[mumpel]

....wo ich doch genau weiß das Du ein Experte in VBA bist...

Das hast Du gesagt. Bin aber kein Experte. So vermessen bin ich nicht, dass ich das von mir behaupten würde.

....ist mir einfach unklar warum Du bei StarBasic bei kleinsten Schwierigkeiten immer alles gleich zur Seite legst....

Noch habe ich nicht aufgegeben. Eine kleine Lösung habe ich schon. Allerdings habe ich dann ein paar Leerzeichen zuviel. Wird aber in der Praxis wohl kaum ins Gewicht fallen. Wer gibt schon mehr Klammern an, als notwendig? Aber vielleicht fällt mir noch etwas anderes ein.

Code: Alles auswählen

Laenge = Len(strT)
For i = 1 to Laenge
strT = Replace(strT(i), "_", " ")
strT = Replace(strT(i), "<", " ")
strT = Replace(strT(i), ">", " ")
strT = Replace(strT(i), "[", " ")
strT = Replace(strT(i), "]", " ")
strT = Replace(strT(i), "~", " ")
strT = Replace(strT(i), "*", " ")
strT = Replace(strT(i), "#", " ")
strT = Replace(strT(i), "\", " ")
strT = Replace(strT(i), "/", " ")
strT = Replace(strT(i), "-", " ")
strT = Replace(strT(i), "(", " ")
strT = Replace(strT(i), ")", " ")
Next i

[Charly]

Hallo Mumpel!

Ich habe meinen Code noch ergänzt als Beispiel. Jetzt wird ein Pluszeichen durch "00 "ersetzt und die beiden folgenden Klammern werden durch ein Leerzeichen ersetzt.

Code: Alles auswählen

Function Replace(StrT)

Erg = ""
Laenge = Len(StrT)
For I = 1 To Laenge

Zeichen = Mid(StrT,I,1)

Select Case Zeichen

Case "+"
Erg = Erg & "00 " 
For I1 = I+1 To Laenge
Klammer = Mid(StrT,I1,1)
If Klammer = "(" or Klammer =")" Then
Erg = Erg + " "
If Erg = ")" Then
Exit for
End if
Else
Erg = Erg + Klammer
End if
next
I = I1


Case "[","]","~","*", "#","\","/","-","(",")"

Case Else
Erg= Erg + Zeichen

end select
next
Replace = Erg
End Function

Gruß
Charly

[mumpel]

Danke! Da habe ich was zum lernen.