Roman Numerals for page numbers (1 Viewer)

T

Tgarse

Guest
Is there a way to print page numbers in roman numerals?
 
R

RedSkies

Registered User.
Local time
Yesterday, 19:09
Joined
Aug 17, 2000
Messages
48
You question got me curious so I was checking out a couple other bulletin boards.

This code was posted on Tek-Tips by RHicks whom I've seen post on this forum numerous times as well (and he's obviously damn good!
)

All you'd need to do on your report is add a textbox control with the control source of
=dhRoman([Page]).

Good luck, and thanks again RHicks.

'This function will convert any number between 1 and 3999 to a Roman Numeral.

Public Function dhRoman(ByVal intValue As Integer) As String
Dim varDigits As Variant
Dim intPos As Integer
Dim IntDigit As Integer
Dim strTemp As String

' Build up the array of roman digits
varDigits = Array("I", "V", "X", "L", "C", "D", "M")
intPos = LBound(varDigits)
strTemp = ""

Do While intValue > 0
IntDigit = intValue Mod 10
intValue = intValue \ 10
Select Case IntDigit
Case 1
strTemp = varDigits(intPos) & strTemp
Case 2
strTemp = varDigits(intPos) & varDigits(intPos) _
& strTemp
Case 3
strTemp = varDigits(intPos) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 4
strTemp = varDigits(intPos) & varDigits(intPos + 1) _
& strTemp
Case 5
strTemp = varDigits(intPos + 1) & strTemp
Case 6
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& strTemp
Case 7
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 8
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & varDigits(intPos) & strTemp
Case 9
strTemp = varDigits(intPos) & varDigits(intPos + 2) _
& strTemp
End Select

intPos = intPos + 2
Loop

dhRoman = strTemp

End Function


[This message has been edited by RedSkies (edited 05-13-2001).]
 
T

Tgarse

Guest
Thanks RedSkies I'll Give it a whirl
 
Solo712

Solo712

Registered User.
Local time
Yesterday, 20:09
Joined
Oct 19, 2012
Messages
828
RedSkies said:
You question got me curious so I was checking out a couple other bulletin boards.

This code was posted on Tek-Tips by RHicks whom I've seen post on this forum numerous times as well (and he's obviously damn good!
)

All you'd need to do on your report is add a textbox control with the control source of
=dhRoman([Page]).

Good luck, and thanks again RHicks.

'This function will convert any number between 1 and 3999 to a Roman Numeral.

Public Function dhRoman(ByVal intValue As Integer) As String
Dim varDigits As Variant
Dim intPos As Integer
Dim IntDigit As Integer
Dim strTemp As String

' Build up the array of roman digits
varDigits = Array("I", "V", "X", "L", "C", "D", "M")
intPos = LBound(varDigits)
strTemp = ""

Do While intValue > 0
IntDigit = intValue Mod 10
intValue = intValue \ 10
Select Case IntDigit
Case 1
strTemp = varDigits(intPos) & strTemp
Case 2
strTemp = varDigits(intPos) & varDigits(intPos) _
& strTemp
Case 3
strTemp = varDigits(intPos) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 4
strTemp = varDigits(intPos) & varDigits(intPos + 1) _
& strTemp
Case 5
strTemp = varDigits(intPos + 1) & strTemp
Case 6
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& strTemp
Case 7
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & strTemp
Case 8
strTemp = varDigits(intPos + 1) & varDigits(intPos) _
& varDigits(intPos) & varDigits(intPos) & strTemp
Case 9
strTemp = varDigits(intPos) & varDigits(intPos + 2) _
& strTemp
End Select

intPos = intPos + 2
Loop

dhRoman = strTemp

End Function


[This message has been edited by RedSkies (edited 05-13-2001).]
Click to expand...

Thanks, RedSkies. I sat down after supper and figured out the modulo
arithmetic myself. It wasn't as steep as I thought. Basically, the Roman numerals are a decimal system with interval markers ('V', 'L' and 'D'). They prevent the same decimal digit (i.e. 'I', 'X',' C',' M') occuring more than three times in succession. It's all regular and orderly. Here is what I came up with. Basically the same thing as RHicks, i.e. modulo-based routine. I found only four "cases" are needed. Here's what I cooked up:

Private Function Roman(x As Integer) As String

Code: 
 If x < 1 Or x > 3999 Then
     Roman = "N/A"
     Exit Function
  End If
 
  Const Letters As String = "MDCLXVI"
  Dim i As Integer, o As Integer, s As Integer, t As Integer, rs As String
 
  rs = ""
 
  o = 1: s = 0
  For i = 7 To 1 Step -2
      t = (x Mod 10 ^ o - s) / 10 ^ (o - 1)
      Select Case t
        Case Is > 8
          rs = Mid(Letters, i, 1) & Mid(Letters, i - 2, 1) & rs
        Case Is > 4
           rs = Mid(Letters, i - 1, 1) & String(t - 5, Mid(Letters, i, 1)) & rs
        Case Is > 3
           rs = Mid(Letters, i, 1) & Mid(Letters, i - 1, 1) & rs
        Case Is > 0
           rs = String(t, Mid(Letters, i, 1)) & rs
      End Select
      s = t * 10 ^ (o - 1) + s
      o = o + 1
  Next i
  Roman = rs
End Function

At any rate, I want to thank you for going out and looking for this stuff. Obviously, doing a modulo routine is way superior approach to hacking out lookup schemes.

Best,
Jiri
 
You must log in or register to reply here.

Similar threads

C
Wrapping long graph across pages
Replies
5
Views
230
June7
June7
A
Print page footer only on the first page
Replies
4
Views
370
gemma-the-husky
gemma-the-husky
A
Display report on the form
Replies
7
Views
378
MajP
MajP
P
Run function in detail_format if total pages > 1
Replies
5
Views
406
Cotswold
Cotswold
J
The Roman reason
2
Replies
30
Views
1,100
Galaxiom
G

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom