OpenOffice.info

Code: Alles auswählen

Sub Fixtermine_Auslesen

Dim FixDoc as object
Dim Fixsheet as object

Fixdoc = ThisComponent
Fixsheet = Fixdoc.sheets(0)
FIxRange = Fixsheet.getcellRangeByName("$W1:$W350")
FixSuchen = FixRange.createReplaceDescriptor
FixSuchen.setSearchString("Fixtermin")
FixSuchen.setReplaceString("Fix ")
Fixrange.replaceAll(FixSuchen)

FixSuchen.setSearchString("Fix")
FixSuchen.setReplaceString("Fix ")
Fixrange.replaceAll(FixSuchen)

for i= 1 to2
FixSuchen.setSearchString("Fix  ")
FixSuchen.setReplaceString(" ")
Fixrange.replaceAll(FixSuchen)
next i

Code: Alles auswählen

for zaehlen = 1 to 350

zellobjekt = Fixsheet.getcellrangebyname ("W" & zaehlen)
Zellinhalt = zellobjekt.string
inhaltlaenge = len(Zellinhalt)
IF inhaltlaenge < 9 then
Zellinhalt = zellinhalt & "xxxxxxxxxxxx"
end if

Code: Alles auswählen

Searchstring = "Fix"

'---Fix finden ----
test = instr(zellinhalt,searchstring) ' Suche Fix in Zellinhalt

test2 = mid(zellinhalt, (test+4), 5) ' Test2 beinhaltet nun 5 Zeichen nach dem Wort Fix+Leerzeichen

zielzelle1 = fixsheet.getcellrangebyname ("AJ" & zaehlen) ' hier wird der wert reingeschrieben

Code: Alles auswählen

if instr(test2,":") > 0 then
c = mid(test2, instr(test2,":")+1)
test3 = val(test2)*10
test4 = val(c)/10
zielzelle1.value = (test3 + test4)/10

Code: Alles auswählen

elseif instr(test2,",") > 0 then
 if val(test2) > 100 then
zielzelle1.value = val(test2)/100
 else
zielzelle1.value = val(test2)/10
 end if
else
zielzelle1.value = val(test2)
end if

next zaehlen

End Sub

Code: Alles auswählen

Dim s(i) as String
Dim myString as String
Dim SecondPartResult as integer
Dim FirstPartResult as integer

Sub Start
	String_auslesen
	ZweiterTeil 'vordere Zahlenfolge auslesen
	DritterTeil 'hintere Zahlenfolge auslesen
	EndResult
end Sub

Sub String_auslesen
	Dim Ist_Numeric as integer
	Dim Zelltext as String
	Dim Laenge1 as integer
	Zelltext = ("Fix 8:34 Uhr Tel. 02225-12345 43 ")
	'Zelltext = ("Fixtermin 6:30 Tour 22")
	'Zelltext = ("Fix 8°°")
	'Zelltext = ("Fix 7,30 Plz: 53359")
	'Zelltext = ("Fixtermin 8,45")
	'Zelltext = ("Fix 7 Uhr")
	'Zelltext = ("Fix 8.10 Uhr")
	Laenge= LEN(Zelltext)
	Check_Space_1 = 0
	for k = 1 to Laenge
	Check_Space = Mid(Zelltext,k,1)
	if  Check_Space = " "  Then
	Check_Space_1 = Check_Space_1 + 1
	end if
	next k	
	t = Check_Space_1 '-1
	for i = 0 to t
	Dim s(1) as String
	s() = Split(Zelltext)
	Aktuell_Wert = s(i)
	Aktuell_Wert1 = left(Aktuell_Wert,1)
	if  isnumeric(Aktuell_Wert1) Then 
	Laenge1 = LEN (s(i))
	myString = s(i)
	exit Sub
	end if
	next i
End Sub

Sub ZweiterTeil
	Dim LaengeMyString as integer
	LaengeMyString = LEN(myString)
	Ist_Numeric1 = 1
	for z = 1 to LaengeMyString
	FirstPart1 = mid(myString,Ist_Numeric1,1)
	if   isnumeric(FirstPart1) Then	
	Ist_Numeric1 = Ist_Numeric1 + 1
	FirstPartResult = Left(myString,Ist_Numeric1-1)
	end if
next z	
End Sub

Sub DritterTeil
	Dim LaengeMyString as integer
	LaengeMyString = LEN(myString)
	Ist_Numeric2 = LaengeMyString
	x = 1
	for z = 1 to LaengeMyString
	SecondPart1 = mid(myString,Ist_Numeric2,1)
	if   isnumeric(SecondPart1) Then	
	Ist_Numeric2 = Ist_Numeric2 - 1
	SecondPartResult = right(myString,Ist_Numeric2)
	end if
	next z
End Sub

Sub EndResult
	myEndResult= FirstPartResult & "," & SecondPartResult
	MyFormat = Format(myEndResult, "00.00"
	msgbox MyFormat
End Sub

Code: Alles auswählen

Sub Check_Mail_Syntax
	Mailadresse = "info@mail.de" 'gültig
	'Mailadresse = "info.mail@mail.de" 'gültig
	'Mailadresse = "info@mail.com" 'gültig
	'Mailadresse = "info@mail.info" 'gültig
	'Mailadresse = "info@mail.d" 'ungültig Endung zu kurz
	'Mailadresse = "info@mail.infos" 'ungültig Endung zu lang
	'Mailadresse = "info@mailbiz" 'unültig weil Punkt fehlt
	'Mailadresse = "infomail.net" 'unültig weil @ fehlt
	'Mailadresse = "info@@mail.de" 'unültig weil @ doppelt
	Laenge= LEN(Mailadresse)
	a = 1
	for i = 1 to Laenge
	Zeichen1 = Mid(Mailadresse,a,1)
	if Zeichen1 = "@" Then
	goto FindPoint
	else
	if a = Laenge then
	goto  Mail_Not_ok
	exit Sub
	end if
	end if
	a = a+1
	next i
	FindPoint: 
 	y = 1
	for i = 0 to 2  
	FindPoint1 = right(Mailadresse,5)
	FindPoint1 = mid(FindPoint1,y,1)
	if FindPoint1 = "." Then
	else
	if y > 2 Then
	goto Mail_Not_ok
	exit Sub
	end if
	end if
	y = y + 1
	next i
	Check_aet_Count = 1
	Check_aet_Count1 = 0 
	for k = 1 to Laenge
	Check_aet = Mid(Mailadresse,Check_aet_Count,1)
	if  Check_aet = "@" Then
	Check_aet_Count1 = Check_aet_Count1 + 1
	end if
	Check_aet_Count = Check_aet_Count + 1
	if Check_aet_Count1 > 1 Then
	goto Mail_Not_ok
	end if
	next k
	Check_Space_1 = 1
	for k = 1 to Laenge
	Check_Space = Mid(Mailadresse,Check_Space_1,1)
	if  Check_Space = chr(32)  Then
	goto Mail_Not_ok
	end if
	Check_Space_1 = Check_Space_1 +1
	next k	
	Mail_ok: msgbox "Die Mailadresse ist gültig"
	exit sub
	Mail_Not_ok: msgbox "Die Mailadresse ist nicht gültig!"
End Sub