title image


Smiley Re: Prof. Add-Inn um DM/EURO und umgekehrt umzurechnen und einiges mehr
Hallo Oliver,Das sind Tausend Wuensche auf einmal.Ein Add-In kann ich Dir leider nicht anbieten, jedoch zwei Konvertierungsfunktionen zum Euro mit individueller Rundungsmoeglichkeit.Den Code als normalen Ascii-Text speichern und die Datei im VBA-Editor in diesen importieren. Nachdem Kompilieren stehen die beiden Funktionen dann unter der Kategorie "Finanz" zur Verfuegung (mit Erlauterungstext).Vielleicht hilft das ja schon mal weiter.Attribute VB_Name = "PublicFunctionsFinance"' Application: Finance functions' Originator: Norbert Koehler' Date: 01.Jan.1999' Shortkey: Nothing' Purpose: Conversion of Currencies to Euro and vice versa.' Convert a Numeric Value into English Words.' ATTENTION: The Intenet Download from Comdirect.de' indicates different value for:' Finnish Markka / EURO FIXING;1 EUR;4.945730'' Irrevocable conversion rates as per 01. Jan. 1999:' 1 EUR = 13.76030 ATS (Austrian Schilling / Österreichische Schilling)' 1 EUR = 40.33990 BEF (Belgian Franc / Belgische Franken)' 1 EUR = 1.955830 DEM (German Mark / Deutsche Mark)' 1 EUR = 166.3860 ESP (Spanish Pesete / Spanische Peseten)' 1 EUR = 5.945730 FIM (Finnish Markka / Finnmark)' 1 EUR = 6.559570 FRF (French Franc / Französische Franken)' 1 EUR = 0.787564 IEP (Irish Punt / Irische Pfund)' 1 EUR = 1936.270 ITL (Italian Lira / Italienische Lire)' 1 EUR = 40.33990 LUF (Luxemburg Franc / Luxemburgische Franken)' 1 EUR = 2.203710 NLG (Dutch Guilder / Niederländische Gulden)' 1 EUR = 200.4820 PTE (Portugese Escudo / Portugiesische Escudos)''' Remark:' The results of the conversion functions are declared as Double on purpose,' since Currency-variables are defined as a fixed-point number' with 15 digits to the left of the decimal point and 4 digits to the right.' These would result in unprecise results with the conversion-factors as given.' Optional the function's result can be rounded by indicating the amout of digits.' By using the built-in worksheet function for rounding the variable "RoundDigits"' has to be a Double-variable.'' Revisions:' 28.Jan.1999 by Norbert Koehler' Conversion Functions declared as Public.' Option Explicit added.' 23.Feb.1999 by Norbert Koehler' English Names od Currencies corrected following' the names as used in the download from Comdirect.de Option Explicit 'forces that all variables are declared Public Function ConvEuroToCurr(InputEuro As Double, OutputCurrency As String, Optional RoundDigits As Double) As DoubleAttribute ConvEuroToCurr.VB_Description = "Convert Euro to a currency like ATS, BEF, DEM, ESP, FIM, FRF, IEP, ITL, LUF, NLG, PTE. Use the abbreviation for the RESULT within the argument 'OutputCurrency'."Attribute ConvEuroToCurr.VB_ProcData.VB_Invoke_Func = " \n1" Dim dblTemp As Double If InputEuro = 0 Then ConvEuroToCurr = 0 Exit Function Else Select Case UCase(Trim(OutputCurrency)) Case "EUR", "CHF", "GBP", "USD", "XEU" ConvEuroToCurr = InputEuro Exit Function Case "DEM" dblTemp = InputEuro * 1.95583 Case "ATS" dblTemp = InputEuro * 13.7603 Case "BEF" dblTemp = InputEuro * 40.3399 Case "FIM" dblTemp = InputEuro * 5.94573 Case "FRF" dblTemp = InputEuro * 6.55957 Case "IEP" dblTemp = InputEuro * 0.787564 Case "ITL" dblTemp = InputEuro * 1936.27 Case "LUF" dblTemp = InputEuro * 40.3399 Case "NLG" dblTemp = InputEuro * 2.20371 Case "PTE" dblTemp = InputEuro * 200.482 Case "ESP" dblTemp = InputEuro * 166.386 Case Else ConvEuroToCurr = 0 Exit Function End Select End If If RoundDigits 0 Then ConvEuroToCurr = Application.Round(dblTemp, RoundDigits) Else ConvEuroToCurr = dblTemp End IfEnd Function Public Function ConvCurrToEuro(InputValue As Double, InputCurrency As String, Optional RoundDigits As Double) As DoubleAttribute ConvCurrToEuro.VB_Description = "Convert currencies like ATS, BEF, DEM, ESP, FIM, FRF, IEP, ITL, LUF, NLG, PTE to Euro. Use the abbreviation for the SOURCE within the argument 'InputCurrency'."Attribute ConvCurrToEuro.VB_ProcData.VB_Invoke_Func = " \n1" Dim dblTemp As Double If InputValue = 0 Then ConvCurrToEuro = 0 Exit Function Else Select Case UCase(Trim(InputCurrency)) Case "EUR", "CHF", "GBP", "USD", "XEU" ConvCurrToEuro = InputValue Exit Function Case "DEM" dblTemp = InputValue / 1.95583 Case "ATS" dblTemp = InputValue / 13.7603 Case "BEF" dblTemp = InputValue / 40.3399 Case "FIM" dblTemp = InputValue / 5.94573 Case "FRF" dblTemp = InputValue / 6.55957 Case "IEP" dblTemp = InputValue / 0.787564 Case "ITL" dblTemp = InputValue / 1936.27 Case "LUF" dblTemp = InputValue / 40.3399 Case "NLG" dblTemp = InputValue / 2.20371 Case "PTE" dblTemp = InputValue / 200.482 Case "ESP" dblTemp = InputValue / 166.386 Case Else ConvCurrToEuro = 0 Exit Function End Select End If If RoundDigits 0 Then ConvCurrToEuro = Application.Round(dblTemp, RoundDigits) Else ConvCurrToEuro = dblTemp End IfEnd FunctionViele GruesseNorbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: