Десятично-двоичный преобразователь (хрестоматийная задача любой ЭВМ)

[Sasha_Smirnov]

Sub ThreeHypostasesOfNumber()
'Считывает (в окне ввода) число и печатает его в 2-чн., 8-чн. и 16-теричн. представлениях.'
'(когда это число больше 2 100 000 000 (точнее, 2-х в степени 31), этот алгоритм не годен)'
Dim i As Byte, N As Variant, dumn0 As String, dumn As String

dumn0 = InputBox("Ваше десятичное число равно...", Application, Day(Date))

For i = 1 To Len(dumn0)
If Mid(dumn0, i, 1) Like "[0-9]" Then dumn = dumn & Mid(dumn0, i, 1)
Next 'убрали из введённого числа всё кроме цифр: пробелы, табуляции и разделители разрядов'

If Not Left(dumn, 1) Like "[0-9]" Then MsgBox "Вы не ввели цифр!": Exit Sub '*** ВЫХОД ***'

N = dumn: MsgBox "Преобразую " & N & " к 2-чному, восьмеричному и шестнадцатеричному виду."

MakeBinOctHex N 'вызов функции, которая преобразует и печатает число N в документе Word'
End Sub

Function MakeBinOctHex(ByRef N)
Dim d As Integer, OctMask As String, BinMask As String
OctMask = Oct(N) 'Сначала представляем в восьмеричном счислении...'
 
For d = Len(OctMask) To 1 Step -1 'Сканируем восьмеричную "маску" справа налево.'
    BinMask = Choose(Mid$(OctMask, d, 1) + 1, _
    "000", "001", "010", "011", "100", "101", "110", "111") & BinMask
'    И заменяем соответственно цифры 0, 1, 2, 3, 4, 5, 6, 7 их двоичными аналогами.'
Next
 
BinMask = Mid$(BinMask, InStr(BinMask, "1"))            'убор начальных нулей из BinMask
 
With Selection
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(15), Alignment:=wdAlignTabRight
.TypeText vbLf & N & " в 2-ичном виде: " & vbTab
.TypeText BinMask 'печать 2-чного, равного введённому в главной процедуре десятичному'
.TypeText vbLf & N & " в 8-меричном виде: " & vbTab
.TypeText OctMask 'печать 8-еричного, равного введённому в главной процедуре 10-чному'
.TypeText vbLf & N & " в 16-теричном виде: " & vbTab & Hex(N) & vbLf    '(в конце - абзац)'
'и наконец - печать шестнадцатеричного вида для введённого в главной процедуре десятичного'
End With
End Function

[Sasha_Smirnov]

Обратную задачу не стал сюда втискивать. И эта-то мало кому понятна, чего уж там.

[viter.alex]

Цифровой гуру.

Скопировал себе файлик на будущее. Сам бы не додумался.

[EducatedFool]

Сканировать восьмеричную маску, конечно же, круто, но не проще ли так:

Sub Dec2Bin()
    a = 123456789: b = ""
    While a > 0: b = a Mod 2 & b: a = a \ 2: Wend
    Debug.Print b    ' число A в двоичном формате
End Sub

[Sasha_Smirnov]

Ясно, проще. Но функция Mod не работает с числами Decimal (Dec).
А так вышло, что это кусок программы, выросшей из той (она здесь есть), что ищет простые числа в «районе» 10 в 29-й степени.

И вообще. Когда что-то УЖЕ работает, то проще — использовать. Чем улучшать.

[Sasha_Smirnov]

Вопрос модераторам: я выше применил к коду соответствующий тэг, но, как видите, он (тэг) сработал только применительно к подпрограмме — Sub, а функция ему неподвластна.

Это так и должно быть, т. е. обработка этим тэгом так и настроена?

А ещё, у EducatedFool, даже Sub не «расцвела», хотя, по-видимому, он тот же тэг использовал. Вот это вот вообще загадка. Для вас тоже?

[EducatedFool]

он (тэг) сработал только применительно к подпрограмме — Sub, а функция ему неподвластна.

Предназначение тэга - выделять\отделять код от остального текста, сохранять в коде отступы и применять определённое форматирование.

Тэг [code]...[/code] не обеспечивает раскраску кода VBA (поскольку соответствующий скрипт разрабатывался для других языков программирования) - поэтому не надо удивляться, что большинство ключевых слов не распознаются.

Можете расскрашивать код самостоятельно
Или применять специальные надстройки для копирования уже отформатированного тэгами кода в буфер обмена:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [d6:i6]) Is Nothing Then
        Cancel = True
        txt = InputBox("Введите индекс"): If Len(txt) <> 6 Then Exit Sub
        For i = 1 To 6
            [d6:i6].Cells(i) = Mid(txt, i, 1)
        Next
    End If
End Sub

В буфере обмена после нажатия кнопки оказывается приблизительно такой текст:

[code][color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_BeforeDoubleClick([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range, Cancel [color=darkblue]As[/color] [color=darkblue]Boolean[/color])
[color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Target, [d6:i6]) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
Cancel = [color=darkblue]True[/color]
txt = InputBox("Введите индекс"): [color=darkblue]If[/color] Len(txt) <> 6 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
[color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] 6
[d6:i6].Cells(i) = Mid(txt, i, 1)
[color=darkblue]Next[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color][/code]

[viter.alex]

Однако раскраска как-то странно работает. Если ключевые слова идут подряд, то зачем к каждому из них применять тэг?
Вот так делаю я своей собственной утилитой:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [d6:i6]) Is Nothing Then
        Cancel = True
        txt = InputBox("Введите индекс"): If Len(txt) <> 6 Then Exit Sub
        For i = 1 To 6
            [d6:i6].Cells(i) = Mid(txt, i, 1)
        Next
    End If
End Sub

А код выглядит так:

[сode][сolor="blue"]Private Sub[/сolor] Worksheet_BeforeDoubleсliсk([сolor="blue"]ByVal[/сolor] Target [сolor="blue"]As[/сolor] Range, сanсel [сolor="blue"]As Boolean[/сolor])
    [сolor="blue"]If Not[/сolor] Interseсt(Target, [d6:i6]) [сolor="blue"]Is Nothing Then[/сolor]
        сanсel = [сolor="blue"]True[/сolor]
        txt = [сolor="blue"]InputBox[/сolor]("Введите индекс"): [сolor="blue"]If[/сolor] Len(txt) <> 6 [сolor="blue"]Then Exit Sub
        For[/сolor] i = 1 [сolor="blue"]To[/сolor] 6
            [d6:i6].сells(i) = [сolor="blue"]Mid[/сolor](txt, i, 1)
        [сolor="blue"]Next
    End If
End Sub[/сolor][/сode]

[Sasha_Smirnov]

Сообщение от EducatedFool

Тэг [code]...[/code] не обеспечивает раскраску кода VBA (поскольку соответствующий скрипт разрабатывался для других языков программирования) - поэтому не надо удивляться, что большинство ключевых слов не распознаются.

Можете расскрашивать код самостоятельно

Да зачем! Главное же отступы.

Я удивлялся не "нераспознанным" ключевым словам (а то, что они ключевые, мы и так знаем) — мне странно, что тот же самый, как вы говорите, скрипт срабатывает с, казалось бы, аналогичным (а порой даже идентичным) текстом кода по-разному: то распознаёт его (вообще как код), то нет.

[Sasha_Smirnov]

Сообщение от Sasha_Smirnov

...я выше применил к коду соответствующий тэг, но, как видите, он (тэг) сработал только применительно к подпрограмме — Sub, а функция ему неподвластна.

Наконец-то и Function заиграла красками: http://programmersforum.ru/showthread.php?t=40897!

Спасибо главному по тегам!