| |
こんばんは。
>APIを使うのが簡単でしょう。
>
>Private Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
> (ByRef Dest As Any, ByRef Source As Any, ByVal length As Long)
>
>Sub test()
> Dim s As Single
>
> MoveMemory s, &H42C80000, LenB(s)
> MsgBox s
>End Sub
ＡＰＩで可能なんですね！！メモメモ
では、私流です。
標準モジュールに
'====================================================================
Sub sample()
Dim dd As Double
Dim ss As Single
'================100===============================
Call prc_movememory(dd, LenB(dd), &H40590000, &H0)
Call prc_movememory(ss, LenB(ss), &H42C80000)
MsgBox "dd= " & dd & vbCrLf & _
"ss= " & ss
'================255===============================
Call prc_movememory(dd, LenB(dd), &H406FE000, &H0)
Call prc_movememory(ss, LenB(ss), &H437F0000)
MsgBox "dd= " & dd & vbCrLf & _
"ss= " & ss
'================0.112===============================
Call prc_movememory(dd, LenB(dd), &H3FBCAC08, &H3126E979)
Call prc_movememory(ss, LenB(ss), &H3DE56042)
MsgBox "dd= " & dd & vbCrLf & _
"ss= " & ss
End Sub
'=========================================================================
Sub prc_movememory(myvalue As Variant, mylen As Long, ParamArray src() As Variant)
Dim g0 As Long
Dim fnum As Long
Dim dd As Double
Dim ss As Single
On Error Resume Next
Const flnm = "\binary.tmp"
Kill ThisWorkbook.Path & flnm
On Error GoTo 0
fnum = FreeFile()
Open ThisWorkbook.Path & flnm For Random As #fnum Len = 4
For g0 = UBound(src()) To LBound(src()) Step -1
Put #fnum, , CLng(src(g0))
Next
Close #fnum
Open ThisWorkbook.Path & flnm For Random As #fnum Len = mylen
If mylen = 4 Then
Get #fnum, 1, ss
Else
Get #fnum, 1, dd
End If
Close #fnum
Kill ThisWorkbook.Path & flnm
myvalue = IIf(mylen = 4, ss, dd)
End Sub
一度保存してからsampleを実行してください。
尚、テンポラリファイルとして上記コードのあるブックと同じフォルダに
「binary.tmp」というファイルが一時的に作成されます。
試してみてください。
|
|
ichinose
- 07/4/18(水) 21:56 -
