Можно так, например:

Public Function Двоичное(Число As Long, Знаков As Long) As Variant     Dim i As Long     Dim Остаток As Long     Dim dv() As Long     ReDim dv(Знаков)     dv(Знаков) = Число Mod 2     Остаток = Число     For i = Знаков - 1 To 1 Step -1         Остаток = Остаток \ 2         dv(i) = Abs(Остаток Mod 2 > 0)     Next i     Двоичное = dv End Function

или так:

Public Function Двоичное(Число As Long, Знаков As Integer) As String     Dim i As Integer     Dim Остаток As Long     Dim dv() As Integer     ReDim dv(Знаков)     dv(Знаков) = Число Mod 2     Остаток = Число     For i = Знаков - 1 To 1 Step -1         Остаток = Остаток \ 2     dv(i) = Abs(Остаток Mod 2 > 0)     Next i     For i = 1 To Знаков         Двоичное = Двоичное & dv(i)     Next i End Function

А уж по полям сами раскидайте.

Вероятно нет 2-го аргумента Знаков As Integer

Нет-нет замечают - очень нужная вещь, однако

Mid$

У меня да, а у Alex-a?
Он не кодом делает, а:

Я в поле, где должно получиться двоичное число, написал так: =Двоичное([ИмяПоляСДесятичнымЧислом])

Интересно, в поле формы вернуть массив получится?

Попробовал, не получилось.
И конструкция =Функция(...)(1) не прошла.

Можно упростить
функция Oct$(число)-возвращает текстовую строку в восьмеричном виде
Каждый символ - цифра от 0 до 7 соответствует в двоичном виде трем цифрам

0    000 1    001 2    010 3    011 4    100 5    101 6    110 7    111

Пример

Public Function ToBinary(ByVal Number As Long) As String          ToBinary = Oct$(Number)          ToBinary = Replace(ToBinary, "0", "000")     ToBinary = Replace(ToBinary, "1", "001")     ToBinary = Replace(ToBinary, "2", "010")     ToBinary = Replace(ToBinary, "3", "011")     ToBinary = Replace(ToBinary, "4", "100")     ToBinary = Replace(ToBinary, "5", "101")     ToBinary = Replace(ToBinary, "6", "110")     ToBinary = Replace(ToBinary, "7", "111")      End Function

по моему наглядней и быстрее

Что ж учтем
наглядность в три раза тормознутее
бум работать

протестируй еще одну функцию, пожалуйста

Public Function DecToBin(DecNum As Long) As String    Dim BinNum As String    Dim i As Integer        BinNum = ""    i = 0    Do       If DecNum And 2 ^ i Then          BinNum = "1" & BinNum       Else          BinNum = "0" & BinNum       End If       i = i + 1    Loop Until 2 ^ i > DecNum    DecToBin = BinNum End Function

Да к сожалению нельзя в VBA вставить ассемблерную строчку как на Паскале и Си
приходится изгаляться
P.S.
не помогло

ShadowOfSun=204 ms          010011100010000 DecToBin=91 ms              10011100010000 Lukas____(3)=52 ms          10011100010000 ------------------------------------------- ShadowOfSun=205 ms          010011100010000 DecToBin=91 ms              10011100010000 Lukas____(3)=54 ms          10011100010000 ------------------------------------------- ShadowOfSun=205 ms          010011100010000 DecToBin=96 ms              10011100010000 Lukas____(3)=53 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=93 ms              10011100010000 Lukas____(3)=52 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=90 ms              10011100010000 Lukas____(3)=52 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=91 ms              10011100010000 Lukas____(3)=51 ms          10011100010000 ------------------------------------------- ShadowOfSun=205 ms          010011100010000 DecToBin=90 ms              10011100010000 Lukas____(3)=54 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=96 ms              10011100010000 Lukas____(3)=53 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=94 ms              10011100010000 Lukas____(3)=53 ms          10011100010000 ------------------------------------------- ShadowOfSun=204 ms          010011100010000 DecToBin=91 ms              10011100010000 Lukas____(3)=52 ms          10011100010000 -------------------------------------------

?DecToBin(0)
Кукиш

Проверим, у меня тоже новая функция:

Public Declare Function apiTimeGetTime Lib "winmm.dll" Alias "timeGetTime" () As Long Public Function ToBinary3(ByVal Number As Long, Optional Digits As Long = 24) As String     Dim Ret As String     Dim i As Long     Const ZERO As String = "0"     Const ONE As String = "1"     Ret = String(Digits, ZERO)          If Number Then         For i = Digits To 0 Step -1             If Number Mod 2 Then                 Mid$(Ret, i, 1) = ONE             End If             Number = Number \ 2         Next i     End If     ToBinary3 = Ret End Function Public Function DecToBin(ByVal DecNum As Long) As String    If DecNum = 0 Then DecToBin = "0" Else DecToBin = ""    Do Until DecNum = 0       If (DecNum Mod 2) Then DecToBin = "1" & DecToBin Else DecToBin = "0" & DecToBin       DecNum = DecNum \ 2    Loop End Function Public Function Test()     Dim i As Long     Dim j As Long     Dim start As Long     Dim str As String     Dim var As Variant          For i = 0 To 5000000 'разгоним процессор         i = i     Next i          For j = 1 To 10         DoEvents         str = ""         start = apiTimeGetTime         For i = 0 To 100000             str = ToBinary3(i, 17)         Next i         Debug.Print "ToBinary3___=" & apiTimeGetTime - start & " ms", str                  DoEvents         str = ""         start = apiTimeGetTime         For i = 0 To 100000             str = DecToBin(i)         Next i         Debug.Print "DecToBin____=" & apiTimeGetTime - start & " ms", str         Debug.Print "-------------------------------------------"              Next j End Function Результаты: ToBinary3___=485 ms         11000011010100000 DecToBin____=687 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=688 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=703 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=688 ms         11000011010100000 ------------------------------------------- ToBinary3___=578 ms         11000011010100000 DecToBin____=828 ms         11000011010100000 ------------------------------------------- ToBinary3___=500 ms         11000011010100000 DecToBin____=672 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=688 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=687 ms         11000011010100000 ------------------------------------------- ToBinary3___=485 ms         11000011010100000 DecToBin____=687 ms         11000011010100000 ------------------------------------------- ToBinary3___=484 ms         11000011010100000 DecToBin____=688 ms         11000011010100000 -------------------------------------------

Ищем сферического коня в вакууме.

Да не с чем поздравлять. Все-равно кривенько как-то.
К тому-же, представлению в виде строки практического применения не вижу.
Надо возвращать массив Long и для проверки глазом сделать функцию преобразования к строке.

Вот и хорошо, не зря "коника искали".

Проверим:

Public Sub ftest()     Dim i As Long     For i = 0 To 10         Debug.Print i, dec2bin$(i)     Next i End Sub Рез-ты:  0              1            1  2            01  3            11  4            001  5            101  6            011  7            111  8            0001  9            1001  10           0101

Ладно, поправим так:

Function dec3bin$(a&)     If a = 0 Then         Exit Function     End If     dec3bin = dec3bin((a \ 2)) & (a Mod 2) End Function Рез-ты:  0              1            1  2            10  3            11  4            100  5            101  6            110  7            111  8            1000  9            1001  10           1010

Уже лучше.
Проверим скорость:

ToBinary3___=500 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=407 ms         11000011010100000 dec3bin$____=1015 ms        11000011010100000 ------------------------------------------- ToBinary3___=406 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=407 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=406 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=390 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=406 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=391 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 ------------------------------------------- ToBinary3___=406 ms         11000011010100000 dec3bin$____=1016 ms        11000011010100000 ------------------------------------------- ToBinary3___=390 ms         11000011010100000 dec3bin$____=1000 ms        11000011010100000 -------------------------------------------

А идея хорошая.

а вот http://members.optusnet.com.au/~draw3d/assembly.html
, говорят, можно скрестить VB с Ассемблером :)

и вот покопацца в коде
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=42427&lngWId=1

ByVal надо, потому как a = (a \ 2)
Добавлено:
Опоздал или не увидел зы.

так я тут потерялся, думаю функцию надо на сайт покласть, только резюмируйте вывод КАКУЮ?
а то все читать времени нет :-( а так боюсь вниз уползет и вообще забуду

Есть новая идея, пока на 10% быстрее прежней. Пока тестю. По окончании покажу.

Вопрос, почему не вот эту?

Public Function ToBinary(ByVal Number As Long) As String     ToBinary = Number Mod 2     Do While Number > 0         Number = Number \ 2         ToBinary = ToBinary & Abs(Number Mod 2 > 0)     Loop     ToBinary = StrReverse(ToBinary)     If Len(ToBinary) > 1 Then ToBinary = Mid(ToBinary, 2) End Function

? LongToBinStr(5)
00000000000000000000000000000101
? ToBinary(5)
101

ОК. понял

А прирост скорости в 5-10 процентов можно добиться маленьким упрощением

Public Function ToBinary(ByVal Number As Long, Optional Digits As Long = 24) As String 'Created by Lukas     Dim i As Long     Const ZERO As String = "0"     Const ONE As String = "1"     ToBinary = String(Digits, ZERO)          If Number Then         For i = Digits To 0 Step -1             If Number Mod 2 Then                 Mid$(ToBinary, i, 1) = ONE             End If             Number = Number \ 2         Next i     End If End Function

2 ShadowOfSun - быстрее на 4% (при 32 знаках)
2 Кабан:
ShadowOfSun + ToBinary ="00000000000000000000000000000000" - быстрее на 8 %, но нет возможности менять кол-во знаков.
Mid$(ToBinary, i, 1) = "1" - медленнее
As integer - медленнее

Вот если бы еще тема была поважнее...
Что может быть важнее "коня в вакууме"?
На самом деле пару раз понадобилась для расчетов оптимизации (перебор вариантов), но не строковая, а Long массив.

ps. Видел бы кто мой последний вариант, со стула бы упал.
Но пока самая быстрая.
ToBinary____=547 ms
LongToBinStr=578 ms
funLongToBin=516 ms (новая)

Новая версия (с учетом поправки ShadowOfSun), надеюсь последняя:

Public Function LongToBinStr(ByVal Number As Long, Optional Digits As Long = 32) As String     Dim i As Long     Const ZERO As String = "0"     Const ONE As String = "1"     LongToBinStr = String(Digits, ZERO)          For i = Digits To 1 Step -1         If Number Mod 2 Then             Mid$(LongToBinStr, i, 1) = ONE         End If         Number = Number \ 2         If Number = 0 Then Exit Function ' уменьшает время на 30% при 32 знаках  и 15% при 24 знаках     Next i End Function

Итого: по сравнению с первой строковой функцией (Двоичное) скорость выросла более чем в 5 раз.

http://hiprog.com/index.php?option=com_content&task=view&id=251661634&Itemid=35

А можно и быстрее

Public Function LongToBin(ByVal Number As Long) As String     Const ZERO As String * 4 = "0000"     Const ONE As String * 4 = "0001"     Const TWO As String * 4 = "0010"     Const THREE As String * 4 = "0011"     Const FOUR As String * 4 = "0100"     Const FIVE As String * 4 = "0101"     Const SIX As String * 4 = "0110"     Const SEVEN As String * 4 = "0111"     Const EIGHT As String * 4 = "1000"     Const NINE As String * 4 = "1001"     Const TEN As String * 4 = "1010"     Const ELEVEN As String * 4 = "1011"     Const TWELVE As String * 4 = "1100"     Const THIRTEEN As String * 4 = "1101"     Const FOURTEEN As String * 4 = "1110"     Const FIFTEEN As String * 4 = "1111"          LongToBin = ""     Do         Select Case Number Mod 16             Case Is = 0: LongToBin = ZERO & LongToBin             Case Is = 1: LongToBin = ONE & LongToBin             Case Is = 2: LongToBin = TWO & LongToBin             Case Is = 3: LongToBin = THREE & LongToBin             Case Is = 4: LongToBin = FOUR & LongToBin             Case Is = 5: LongToBin = FIVE & LongToBin             Case Is = 6: LongToBin = SIX & LongToBin             Case Is = 7: LongToBin = SEVEN & LongToBin             Case Is = 8: LongToBin = EIGHT & LongToBin             Case Is = 9: LongToBin = NINE & LongToBin             Case Is = 10: LongToBin = TEN & LongToBin             Case Is = 11: LongToBin = ELEVEN & LongToBin             Case Is = 12: LongToBin = TWELVE & LongToBin             Case Is = 13: LongToBin = THIRTEEN & LongToBin             Case Is = 14: LongToBin = FOURTEEN & LongToBin             Case Is = 15: LongToBin = FIFTEEN & LongToBin         End Select         Number = Number \ 16    Loop Until Number = 0 End Function

по моему на любителя
За то не потеряются первые цифры при неправильном указании разрядности
и +1,5% . Эх мне бы их с прибыли какого нибудь банка