Jak zwrócić aktualny miesiąc jako liczbę rzymską?

Wielokrotnie podczas programowania potrzeba zwrócić numer miesiąca (niekoniecznie aktualnego) jako liczbę rzymską. Po co? Otóż czasami np. wygenerowany numer zamówienia ma w sobie zawarty miesiąc. I klientka zażyczyła sobie, aby miesiąc nie był jako numer miesiąca, tylko była to liczba rzymska. Pierwsza moja myśl była następująca:

Function PodajMiesiacRzymski(Miesiac As Long) As String
    Dim Ret As String
    
    Select Case Miesiac
        Case 1: Ret = "I"
        Case 2: Ret = "II"
        Case 3: Ret = "III"
        Case 4: Ret = "IV"
        Case 5: Ret = "V"
        Case 6: Ret = "VI"
        Case 7: Ret = "VI"
        Case 8: Ret = "VIII"
        Case 9: Ret = "IX"
        Case 10: Ret = "X"
        Case 11: Ret = "XI"
        Case 12: Ret = "XII"
        Case Else: Ret = "zły miesiąc"
    End Select
    
    
    PodajMiesiacRzymski = Ret
End Function


Sub Testuj()
    Dim Miesiac As Long
    
    Miesiac = Month(Date)
    MsgBox "Obecny miesiąc jako liczba rzymska to: " + PodajMiesiacRzymski(Miesiac), vbInformation
End Sub

Instrukcja Select Case jest bardzo wygodna, gdyż w przypadku podania nietypowego numeru klauzura Case Else może zwrócić wartość domyślną (np. pusty ciąg znaków, tekst zły miesiąc itp.)

Inne „podręcznikowe” rozwiązanie jakie często widuję to „stablicowanie” numerów miesięcy i zwrócenie odpowiedniego elementu tablicy. No ale, nie byłoby tego wpisu, gdyby nie fakt, że można to zrobić nieco sprytniej.

Otóż w Excelu istnieje taka funkcja jak RZYMSKIE, która zwraca liczbę rzymską. W VBA również można zwracać liczby rzymskie korzystając z wbudowanej funkcji Excela. Otóż można wywołać metodę: Application.WorksheetFunction.Roman. Zwróć uwagę, że tutaj nazwy funkcji są w wersji angielskiej (czyli Roman a nie Rzymskie). Ale ta metoda przyjmuje dokładnie takie same argumenty jak arkuszowa funkcja RZYMSKIE. Więc mój kod może wyglądać nieco prościej:

Function PodajMiesiacRzymski(Miesiac As Long) As String
    Dim Ret As String
    
    If Miesiac >= 1 And Miesiac <= 12 Then
        Ret = Application.WorksheetFunction.Roman(Miesiac)
    Else
        Ret = "zły miesiąc"
    End If
    
    PodajMiesiacRzymski = Ret
End Function


Sub Testuj()
    Dim Miesiac As Long
    
    Miesiac = Month(Date)
    MsgBox "Obecny miesiąc jako liczba rzymska to: " + PodajMiesiacRzymski(Miesiac), vbInformation
End Sub

Uwaga: funkcja RZYMSKIE (jak również jej kalka w VBA w postaci metody Application.WorksheetFunction.Roman) jako argument przyjmuje liczbę z zakresu od 1 do 3999. Dla innych wartości zostanie zwrócony błąd.

Uwaga: Metoda Application.WorksheetFunction.Roman jest dostępna tylko w VBA dla Excela. Jeśli potrzebujesz liczb rzymskich np. w VBA dla Worda to niestety, ale należy albo napisać jakiś algorytm do zamiany liczb arabskich na rzymskie, albo w przypadku gdy tych wartości jest niewiele (np. 12 dla miesięcy) „stablicować” liczby rzymskie lub użyć konstrukcji Select Case z zhardkodowanymi wartościami.