Hallo Makrospezialisten
Ich hab mir hier mit Hilfe von ->Makro aufzeichnen ,
und (weitesgehend) mit Suchen und Ersetzen ein Makro
gebaut, das Textstrings in der Form von chemischen Summenformeln,
zb.CaCO3, NaCl oder NH4Fe(SO4)2,
in eine scalc-Funktion umstrukturiert,die dann im Tabellenblatt
ausgewertet wird; d.h. zu einer chem. Summenformel wird das
entsprechende Molekularewicht errechnet.
Das funktioniert jetzt so,das ich eine chem.Summenformel eingebe und das
Makro per Shortcut starte, das Ergebniss wird dann in die Zelle
unterhalb ausgegeben.
Meine Frage ist:
Wie kann ich erreichen das mit "=MOLGEWICHT(A1)"
das Makro aus einer beliebigen Zelle(xy) heraus als Function aufgerufen
werden kann, und das Ergebniss in dieser Zelle(xy) ausgegeben wird ?
Danke für entsprechende Tips
Gruß
Werner
Ps. Nachfolgend der (die/das)? Makrocode
und danach die Liste der rel.Atommassen
(für diejenigen die es ausprobieren wollen:
die Liste in eine Tabelle kopieren, und mit Namen
"relamasse" versehen)
Pss.Entschuldigung für die lange [EMAIL PROTECTED]
REM ***** BASIC *****MOLGEWICHT*****
function Molgewicht
rem --Wandelt per Suchen und Ersetzen chemische Summenformeln
' in scalc Funktionen---------------
rem define variables
dim document as object
dim dispatcher as object
rem --------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
rem ----Fehlmeldungen-durch-nicbt-vorhandene-Regex-verhindern----
dim args4(17) as new com.sun.star.beans.PropertyValue
args4(0).Name = "SearchItem.StyleFamily"
args4(0).Value = 2
args4(1).Name = "SearchItem.CellType"
args4(1).Value = 1
args4(2).Name = "SearchItem.RowDirection"
args4(2).Value = true
args4(3).Name = "SearchItem.AllTables"
args4(3).Value = false
args4(4).Name = "SearchItem.Backward"
args4(4).Value = false
args4(5).Name = "SearchItem.Pattern"
args4(5).Value = false
args4(6).Name = "SearchItem.Content"
args4(6).Value = false
args4(7).Name = "SearchItem.AsianOptions"
args4(7).Value = false
args4(8).Name = "SearchItem.AlgorithmType"
args4(8).Value = 1
args4(9).Name = "SearchItem.SearchFlags"
args4(9).Value = 71680
args4(10).Name = "SearchItem.SearchString"
args4(10).Value = ".*"
args4(11).Name = "SearchItem.ReplaceString"
args4(11).Value = "&(+5"
args4(12).Name = "SearchItem.Locale"
args4(12).Value = 255
args4(13).Name = "SearchItem.ChangedChars"
args4(13).Value = 2
args4(14).Name = "SearchItem.DeletedChars"
args4(14).Value = 2
args4(15).Name = "SearchItem.InsertedChars"
args4(15).Value = 2
args4(16).Name = "SearchItem.TransliterateFlags"
args4(16).Value = 1024
args4(17).Name = "SearchItem.Command"
args4(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args4())
rem ---Multiplikationszeichen-vor Zahlen setzen------------
dim args5(17) as new com.sun.star.beans.PropertyValue
args5(0).Name = "SearchItem.StyleFamily"
args5(0).Value = 2
args5(1).Name = "SearchItem.CellType"
args5(1).Value = 1
args5(2).Name = "SearchItem.RowDirection"
args5(2).Value = true
args5(3).Name = "SearchItem.AllTables"
args5(3).Value = false
args5(4).Name = "SearchItem.Backward"
args5(4).Value = false
args5(5).Name = "SearchItem.Pattern"
args5(5).Value = false
args5(6).Name = "SearchItem.Content"
args5(6).Value = false
args5(7).Name = "SearchItem.AsianOptions"
args5(7).Value = false
args5(8).Name = "SearchItem.AlgorithmType"
args5(8).Value = 1
args5(9).Name = "SearchItem.SearchFlags"
args5(9).Value = 71680
args5(10).Name = "SearchItem.SearchString"
args5(10).Value = "[1-9][0-9]?[0-9]?"
args5(11).Name = "SearchItem.ReplaceString"
args5(11).Value = "*&"
args5(12).Name = "SearchItem.Locale"
args5(12).Value = 255
args5(13).Name = "SearchItem.ChangedChars"
args5(13).Value = 2
args5(14).Name = "SearchItem.DeletedChars"
args5(14).Value = 2
args5(15).Name = "SearchItem.InsertedChars"
args5(15).Value = 2
args5(16).Name = "SearchItem.TransliterateFlags"
args5(16).Value = 1024
args5(17).Name = "SearchItem.Command"
args5(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args5())
rem -Elementkürzel in SVERWEIS-Formel einpacken '
' !!benötigt eine Atommassenliste mit Namen
'"relamasse"!!---------------------------------------
dim args6(17) as new com.sun.star.beans.PropertyValue
args6(0).Name = "SearchItem.StyleFamily"
args6(0).Value = 2
args6(1).Name = "SearchItem.CellType"
args6(1).Value = 1
args6(2).Name = "SearchItem.RowDirection"
args6(2).Value = true
args6(3).Name = "SearchItem.AllTables"
args6(3).Value = false
args6(4).Name = "SearchItem.Backward"
args6(4).Value = false
args6(5).Name = "SearchItem.Pattern"
args6(5).Value = false
args6(6).Name = "SearchItem.Content"
args6(6).Value = false
args6(7).Name = "SearchItem.AsianOptions"
args6(7).Value = false
args6(8).Name = "SearchItem.AlgorithmType"
args6(8).Value = 1
args6(9).Name = "SearchItem.SearchFlags"
args6(9).Value = 71680
args6(10).Name = "SearchItem.SearchString"
args6(10).Value = "[A-Z][a-z]?"
args6(11).Name = "SearchItem.ReplaceString"
args6(11).Value = "+SVERWEIS("+CHR$(34)+"&"+CHR$(34)+";relamasse;3;0)"
args6(12).Name = "SearchItem.Locale"
args6(12).Value = 255
args6(13).Name = "SearchItem.ChangedChars"
args6(13).Value = 2
args6(14).Name = "SearchItem.DeletedChars"
args6(14).Value = 2
args6(15).Name = "SearchItem.InsertedChars"
args6(15).Value = 2
args6(16).Name = "SearchItem.TransliterateFlags"
args6(16).Value = 1024
args6(17).Name = "SearchItem.Command"
args6(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args6())
rem -Ersetzen von "(+"durch"+("--Richtigstellung der
Vorzeichen------------------------------------------
dim args7(17) as new com.sun.star.beans.PropertyValue
args7(0).Name = "SearchItem.StyleFamily"
args7(0).Value = 2
args7(1).Name = "SearchItem.CellType"
args7(1).Value = 1
args7(2).Name = "SearchItem.RowDirection"
args7(2).Value = true
args7(3).Name = "SearchItem.AllTables"
args7(3).Value = false
args7(4).Name = "SearchItem.Backward"
args7(4).Value = false
args7(5).Name = "SearchItem.Pattern"
args7(5).Value = false
args7(6).Name = "SearchItem.Content"
args7(6).Value = false
args7(7).Name = "SearchItem.AsianOptions"
args7(7).Value = false
args7(8).Name = "SearchItem.AlgorithmType"
args7(8).Value = 0
args7(9).Name = "SearchItem.SearchFlags"
args7(9).Value = 71680
args7(10).Name = "SearchItem.SearchString"
args7(10).Value = "(+"
args7(11).Name = "SearchItem.ReplaceString"
args7(11).Value = "+("
args7(12).Name = "SearchItem.Locale"
args7(12).Value = 255
args7(13).Name = "SearchItem.ChangedChars"
args7(13).Value = 2
args7(14).Name = "SearchItem.DeletedChars"
args7(14).Value = 2
args7(15).Name = "SearchItem.InsertedChars"
args7(15).Value = 2
args7(16).Name = "SearchItem.TransliterateFlags"
args7(16).Value = 1024
args7(17).Name = "SearchItem.Command"
args7(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args7())
rem --Entfernen des Fehlerabfangstrings aus args4-----
dim args8(17) as new com.sun.star.beans.PropertyValue
args8(0).Name = "SearchItem.StyleFamily"
args8(0).Value = 2
args8(1).Name = "SearchItem.CellType"
args8(1).Value = 1
args8(2).Name = "SearchItem.RowDirection"
args8(2).Value = true
args8(3).Name = "SearchItem.AllTables"
args8(3).Value = false
args8(4).Name = "SearchItem.Backward"
args8(4).Value = false
args8(5).Name = "SearchItem.Pattern"
args8(5).Value = false
args8(6).Name = "SearchItem.Content"
args8(6).Value = false
args8(7).Name = "SearchItem.AsianOptions"
args8(7).Value = false
args8(8).Name = "SearchItem.AlgorithmType"
args8(8).Value = 0
args8(9).Name = "SearchItem.SearchFlags"
args8(9).Value = 71680
args8(10).Name = "SearchItem.SearchString"
args8(10).Value = "+(*5"
args8(11).Name = "SearchItem.ReplaceString"
args8(11).Value = ""
args8(12).Name = "SearchItem.Locale"
args8(12).Value = 255
args8(13).Name = "SearchItem.ChangedChars"
args8(13).Value = 2
args8(14).Name = "SearchItem.DeletedChars"
args8(14).Value = 2
args8(15).Name = "SearchItem.InsertedChars"
args8(15).Value = 2
args8(16).Name = "SearchItem.TransliterateFlags"
args8(16).Value = 1024
args8(17).Name = "SearchItem.Command"
args8(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args8())
rem --Führendes + Zeichen durch = ersetzen-------------------------
dim args9(17) as new com.sun.star.beans.PropertyValue
args9(0).Name = "SearchItem.StyleFamily"
args9(0).Value = 2
args9(1).Name = "SearchItem.CellType"
args9(1).Value = 1
args9(2).Name = "SearchItem.RowDirection"
args9(2).Value = true
args9(3).Name = "SearchItem.AllTables"
args9(3).Value = false
args9(4).Name = "SearchItem.Backward"
args9(4).Value = false
args9(5).Name = "SearchItem.Pattern"
args9(5).Value = false
args9(6).Name = "SearchItem.Content"
args9(6).Value = false
args9(7).Name = "SearchItem.AsianOptions"
args9(7).Value = false
args9(8).Name = "SearchItem.AlgorithmType"
args9(8).Value = 1
args9(9).Name = "SearchItem.SearchFlags"
args9(9).Value = 71680
args9(10).Name = "SearchItem.SearchString"
args9(10).Value = "^+"
args9(11).Name = "SearchItem.ReplaceString"
args9(11).Value = "="
args9(12).Name = "SearchItem.Locale"
args9(12).Value = 255
args9(13).Name = "SearchItem.ChangedChars"
args9(13).Value = 2
args9(14).Name = "SearchItem.DeletedChars"
args9(14).Value = 2
args9(15).Name = "SearchItem.InsertedChars"
args9(15).Value = 2
args9(16).Name = "SearchItem.TransliterateFlags"
args9(16).Value = 1024
args9(17).Name = "SearchItem.Command"
args9(17).Value = 3
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "",_ 0,args9())
'Der Summenformelstring ist zu einer Rechenfunktion geworden,
'und wird von Scalc ausgerechnet
end function
REM ****** ENDE**********BASIC
Atommassenliste:"relamasse"
H Wasserstoff 1,01
He Helium 4
Li Lithium 6,94
Be Beryllium 9,01
B Bor 10,81
C Kohlenstoff 12,01
N Stickstoff 14,01
O Sauerstoff 16
F Fluor 19
Ne Neon 20,18
Na Natrium 22,99
Mg Magnesium 24,31
Al Aluminium 26,98
Si Silicium 28,09
P Phosphor 30,97
S Schwefel 32,07
Cl Chlor 35,45
K Kalium 39,1
Ar Argon 39,95
Ca Calcium 40,08
Sc Scandium 44,96
Ti Titan 47,88
V Vanadium 50,94
Cr Chrom 52
Mn Mangan 54,94
Fe Eisen 55,85
Ni Nickel 58,69
Co Cobalt 58,93
Cu Kupfer 63,55
Zn Zink 65,39
Ga Gallium 69,72
Ge Germanium 72,61
As Arsen 74,92
Se Selen 78,96
Br Brom 79,9
Kr Krypton 83,8
Rb Rubidium 85,47
Sr Strontium 87,62
Y Yttrium 88,91
Zr Zirconium 91,22
Nb Niob 92,91
Mo Molybdän 95,94
Tc Technetium 98,91
Ru Ruthenium 101,07
Rh Rhodium 102,91
Pd Palladium 106,42
Ag Silber 107,87
Cd Cadmium 112,41
In Indium 114,82
Sn Zinn 118,71
Sb Antimon 121,75
I Iod 126,9
Te Tellur 127,6
Xe Xenon 131,29
Cs Cäsium 132,91
Ba Barium 137,33
La Lanthan 138,91
Ce Cer 140,12
Pr Praseodym 140,91
Nd Neodym 144,24
Pm Promethium 146,92
Sm Samarium 150,36
Eu Europium 151,97
Gd Gadolinium 157,25
Tb Terbium 158,93
Dy Dysprosium 162,5
Ho Holmium 164,93
Er Erbium 167,26
Tm Thulium 168,93
Yb Ytterbium 173,04
Lu Lutetium 174,97
Hf Hafnium 178,49
Ta Tantal 180,95
W Wolfram 183,85
Re Rhenium 186,21
Os Osmium 190,2
Ir Iridium 192,22
Pt Platin 195,08
Au Gold 196,97
Hg Quecksilber 200,59
Tl Thallium 204,38
Pb Blei 207,2
Bi Bismut 208,98
Po Polonium 208,98
At Astat 209,99
Rn Radon 222,02
Fr Francium 223,02
Ra Radium 226,03
Ac Actinium 227,03
Pa Protactinium 231,04
Th Thorium 232,04
Np Neptunium 237,05
U Uran 238,03
Am Americium 243,06
Pu Plutonium 244,06
Cm Curium 247,07
Bk Berkelium 247,07
Cf Californium 251,08
Es Einsteinium 252,08
Fm Fermium 257,1
Md Mendelevium 258,1
No Nobelium 259,1
Lr Lawrencium 260,11
Rf Rutherfordium 261,11
Db Dubnium 262,11
Bh Bohrium 262,12
Sg Seaborgium 263,12
Hs Hassium 265
Mt Meitnerium 266
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
