Ciao oregon

Scusami per il ritardo nel rispondere.
Il tuo codice è assolutamente ottimo ed è per me un riferimento in quanto ne ero a conoscenza soltanto in minima parte.

Ho provato però a cercare una soluzione alternativa utilizzando quello che c'è in VB e sono a riuscito ad ottentere lo stesso risultato.
Praticamente considero i termini dell'operazione come array di byte e ne eseguo la moltiplicazione trasportando il risultato ancora in un array di byte.
Successivamente riconverto il risultato in un long con segno.

Ad esempio:
codice:
Private Sub Command1_Click()
Dim Numero1(3) As Byte
Dim Numero2(3) As Byte
Dim Risultato() As Byte
Dim RisLong As Long


'&H87654321
Numero1(3) = &H87
Numero1(2) = &H65
Numero1(1) = &H43
Numero1(0) = &H21
'&H12345678
Numero2(3) = &H12
Numero2(2) = &H34
Numero2(1) = &H56
Numero2(0) = &H78
Call Moltiplicazione(Numero1, Numero2, Risultato)
Call BytesInLong(Risultato, RisLong)

'&H70B88D78
MsgBox Hex(RisLong)

End Sub


Private Sub Moltiplicazione(ByRef Moltiplicando() As Byte, ByRef Moltiplicatore() As Byte, ByRef Prodotto() As Byte)
On Error Resume Next

Dim Cont1 As Integer
Dim Cont2 As Integer
Dim ContRiporto As Integer

Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long

ReDim Prodotto(0)


'Elimina eventuali byte vuoti
'ad es. 0000AABB = AABB
'------------------------------------
Cont1 = UBound(Moltiplicando)
Do While (a = 0&) And (Cont1 > 0)
  a = CLng(Moltiplicando(Cont1))
  If (a = 0&) Then
    ReDim Preserve Moltiplicando(Cont1 - 1)
  End If
  Cont1 = (Cont1 - 1)
Loop

Cont1 = UBound(Moltiplicatore)
a = 0&
Do While (a = 0&) And (Cont1 > 0)
  a = CLng(Moltiplicatore(Cont1))
  If (a = 0&) Then
    ReDim Preserve Moltiplicatore(Cont1 - 1)
  End If
  Cont1 = (Cont1 - 1)
Loop
'------------------------------------


For Cont1 = 0 To UBound(Moltiplicando)

  a = CLng(Moltiplicando(Cont1))
  
  For Cont2 = 0 To UBound(Moltiplicatore)
  
    b = CLng(Moltiplicatore(Cont2))
    d = a * b
    
    If d > 0 Then
    
      '---------------------------------------------
      ' PRIMO BYTE DEL PRODOTTO
      '---------------------------------------------
      If (Cont1 + Cont2) > UBound(Prodotto) Then
        ReDim Preserve Prodotto(Cont1 + Cont2)
      End If
    
      c = Prodotto(Cont1 + Cont2)
      c = c + (d And 255&)
      Prodotto(Cont1 + Cont2) = CByte((c And 255&))
    
        ' Gestione riporto
        c = c \ 256&
        ContRiporto = Cont2
        Do While (c > 0&)
          If (Cont1 + ContRiporto + 1) > UBound(Prodotto) Then
            ReDim Preserve Prodotto(Cont1 + ContRiporto + 1)
          End If
        
          c = c + CLng(Prodotto(Cont1 + ContRiporto + 1))
          Prodotto(Cont1 + ContRiporto + 1) = CByte((c And 255&))
      
          ContRiporto = ContRiporto + 1
          c = c \ 256&
        Loop

    
      d = d \ 256&
      If d > 0 Then
      
        '---------------------------------------------
        ' SECONDO BYTE DEL PRODOTTO
        '---------------------------------------------
        If (Cont1 + Cont2 + 1) > UBound(Prodotto) Then
          ReDim Preserve Prodotto(Cont1 + Cont2 + 1)
        End If
    
        c = CLng(Prodotto(Cont1 + Cont2 + 1))
        c = c + (d And 255&)
        Prodotto(Cont1 + Cont2 + 1) = CByte((c And 255&))
    
          ' Gestione riporto
          c = c \ 256&
          ContRiporto = Cont2
          Do While (c > 0&)
            If (Cont1 + ContRiporto + 2) > UBound(Prodotto) Then
              ReDim Preserve Prodotto(Cont1 + ContRiporto + 2)
            End If

            c = c + CLng(Prodotto(Cont1 + ContRiporto + 2))
            Prodotto(Cont1 + ContRiporto + 2) = CByte((c And 255&))
      
            ContRiporto = ContRiporto + 1
            c = c \ 256&
          Loop
        
      End If
    End If

  Next Cont2
Next Cont1

End Sub

Private Sub BytesInLong(ByRef ArrByte() As Byte, ByRef Var As Long)
On Error Resume Next

Dim Cont As Integer
Dim Num As Integer
Dim Massimo As Integer


Massimo = UBound(ArrByte)
If UBound(ArrByte) > 3 Then
  Massimo = 3
End If

If Massimo < 3 Then
  Var = 0
  For Cont = 0 To Massimo
    Var = Var + (ArrByte(Cont) * (256 ^ Cont))
  Next Cont
  
Else

  If ArrByte(3) < 128 Then
    Var = 0
    For Cont = 0 To Massimo
      Var = Var + (ArrByte(Cont) * (256 ^ Cont))
    Next Cont
  Else
    Var = 0
    For Cont = 0 To Massimo
      If Cont = 0 Then
        Num = 256 - ArrByte(Cont)
      Else
        Num = 255 - ArrByte(Cont)
      End If
      
      Var = Var + (Num * (256 ^ Cont))
    Next Cont
    
    Var = Var * -1
  End If
  
End If

End Sub
Di sicuro è meglio utilizzare la tua soluzione, però mi sono divertito a provare.

Grazie