スキルアップ・問題解決なら、モーグにおまかせ！

※ PCに関する事なら、何でもどうぞ。
前スレ
http://www.moug.net/faq/viewtopic.php?t=60115

yayadonさん、回答ありがとうございます。
(勉強になります)
 
Abyssさん、
> 64bitでの話ですか？
http://www.ka-net.org/office/of32.html
そうですね。なので、

CreateObject ("JScript")

前スレの
> タイプライブラリの定義間違いが、どこだか分からない。
これは、
 
個別に変数を宣言すれば、どのCOMインターフェースがコケてるか分かるので、

    Dim std_excepinfo As stdole.EXCEPINFO

>それで、何でもなかったようです。
  
意味がよく分かりませんけど。
  
でも、32bitでは問題ないことで、安心です。
一応、自分のところでは問題ないし。
 
ありがとうございます。

yayadon さんの引用:

' 同一セルに対して，別の参照経由で設定＆取得
rng(0).Value = i
lngValue = rng(1).Value

rng(0).ID = i
lngValue = rng(1).ID

月 さんの引用:

yayadon さんの引用:

' 同一セルに対して，別の参照経由で設定＆取得
rng(0).Value = i
lngValue = rng(1).Value

rng(0).ID = i
lngValue = rng(1).ID

とすると同時参照数が影響しませんでした。
メンバによっても違うようです。

[補足]
 

yayadon さんの引用:
引数の型とデータ値の型が違う場合，引数の型にあわせるために一時変数が作成されて，

[補足の補足]
 

yayadon さんの引用:
数値の場合，Variant型での演算が遅い

Letステートメントについて書き直してみました。
 
 
-----
■ Letステートメント
  
　[Let] 左辺式 = 式
  
　( [Let] l-expression = expression )
  
の形をとります。[ ] は省略可能を示す。
 
Letステートメントは単純データ値だけを扱うと決めた関係で，
代入する値を決める右側の 式 だけでなく 左辺式 も
  
　単純データ値への評価　(Evaluation to a simple value)
  
が必要になります。
 
例えば，
 

Application.ActiveCell = 0

        [id(00000000), propget, helpcontext(0x00010000)]
        VARIANT _Default(
                        [in, optional] VARIANT RowIndex, 
                        [in, optional] VARIANT ColumnIndex);

        [id(00000000), propput, helpcontext(0x00010000)]
        void _Default(
                        [in, optional] VARIANT RowIndex, 
                        [in, optional] VARIANT ColumnIndex, 
                        [in] VARIANT rhs);

Application.ActiveCell = 0

        [id(00000000), propput, helpcontext(0x00010000)]
        void _Default(
                        [in, optional] VARIANT RowIndex, 
                        [in, optional] VARIANT ColumnIndex, 
                        [in] VARIANT rhs);

Application.ActiveCell = Application.ActiveCell

        [id(00000000), propget, helpcontext(0x00010000)]
        VARIANT _Default(
                        [in, optional] VARIANT RowIndex, 
                        [in, optional] VARIANT ColumnIndex);

Application.ActiveCell = Application.ActiveCell

VARIANT型引数rhs = VARIANT型のデータ値

Application.ActiveWorkbook = Application.ActiveWorkbook

# Abyssさんの意図としては、個人のブログでないのだから、一般的な認識・常識に基づいて
  コメントされてくださいと言うことなのでしょう。
  (Office2010も規定でインストールするのは32ビット版ですし)
 
> 32bitでは問題ないことで、
 
WOW64とx86が完全互換とされない事例にScript Controlがあります。
http://page.freett.com/futabe/tps/sc/ascript.html
 
 
> 意味がよく分かりませんけど。
 
32bit版のタイプライブラリを64bit版に直してる過程でこちらのエラーが出て、

関数またはインターフェイスが予約されているか、または Visual Basic でサポートされていないオートメーション タイプが関数で使用されています。

前回スレの大分前の発言で恐縮なのですが、気になったので。

kumatti さんの引用:
のちのちVBAにとってうれしいニュースとなるんじゃないかと思うんですが， Metro 用の Native API である Windows Runtime のクラスですが，(.NET のクラスと違って) クラスのインスタンス管理に参照カウント方式が採用されました。
 
（略）
 
.NET API は参照カウント方式が無い関係で，VBA とはどうも相性がよくなかったんですが，VBAも今度は相性よく対応できるでしょう。

[訂正]
 
上の Let ステートメント の説明の中で，
 
　Getプロパティ
　Letプロパティ
 
と表現していましたが，
VBAの仕様書通りに 英語のまま かつ 太文字 で
 
　Property Get
　Property Let
 
とするか，全部を日本語として表現する
 
　取得プロパティ
　設定プロパティ
 
のように変更することにしました。
(片方だけ日本語に訳すのは，ある意味では，誤訳な気がしたためです)
 
 
一般的に，取得する方を getter といい，設定する方を setter といいますが，
VBA仕様書(ver 1.0)では，その用語が出てこないので，
Let ステートメントを説明する時など，正式な説明では，使わない方が無難です。
 
 
また，一般的なVBAの解説では使われない用語ですが
 
　データ値　(data value)
　単純データ値　(simple data value)
　単純データ演算子　(simple data operator)
　Let-型強制　(Let-coercion)
 
等は，VBA仕様書(ver 1.0)に出てくる正式な用語/表現を使っています。
安心して使ってください。
 
 
 

引用:
propget 属性が付いている方が，Getプロパティ(取得プロパティ)で，
propput 属性が付いている方が，Letプロパティ(設定プロパティ)です。

引用:
上のふたつの内，
設定できるプロパティは，Letプロパティの方になります。

ろひ さんの引用:

kumatti さんの引用:
のちのちVBAにとってうれしいニュースとなるんじゃないかと思うんですが， Metro 用の Native API である Windows Runtime のクラスですが，(.NET のクラスと違って) クラスのインスタンス管理に参照カウント方式が採用されました。
 
（略）
 
.NET API は参照カウント方式が無い関係で，VBA とはどうも相性がよくなかったんですが，VBAも今度は相性よく対応できるでしょう。

引用:
VBAも今度は相性よく対応できるでしょう。

ろひ さんの引用:
Windows8(Metro)上においては、VBAからの.NET FlameworkのAPI利用が安定しそうだ

ろひ さんの引用:
更には、既存の環境(WindowsやOffice)においても、Windows8(Metro)対応の.NET Flameworkが導入された環境であれば、安定しそうだ（＝相性の改善が見込める可能性がある）、という様になりうるのでしょうか？

ろひ さんの引用:
VBAからの.NET Flameworkが盛んになりえるなら嬉しいのですが、そこまでの可能性もありえそうでしょうか？

yayadonさん、丁寧な解説ありがとうございます。
(あちこち飛んで見てたらお名前が間違ってましてkumattiさんにも失礼いたしました。)

yayadon さんの引用:
すでに，Windows 7 において，Windows API (Win32 API) の抽象化が行われ始めていて，
本当に基本的な機能を提供するものとその上位の機能を提供するものとを整理し始めています。
(機能のレベルが違うものが相互依存しないように整理し始めているということです)
 
Windows 8 以降では，各言語に対して，もっとニュートラルなクラス群を提供して行こうというのが，あたらしいAPI設計のベースにあります。
 
最終的には，その基本的な機能を提供するAPIだけを使ったニュートラルなクラス群を提供するのが目的でしょう。

yayadon さんの引用:
VBAは，.NET Framework (のクラス群)にはうまく対応できませんでしたが，今度の Windows Runtime のクラス群には相性よく対応できるでしょう。

yayadon さんの引用:
今回は，提供するクラス群や定数等を説明するのに，その タイプ ライブラリー は使わずに，メタファイル と呼ばれているものを使います。
 
メタファイルは，.NET系のクラス群を説明するために使われてきたものです。
 
残念なことに，現在のVBAでは，メタファイル内のクラス群を参照設定できません。
どうなるのか？は，次期Officeの発表までは，なんとも言えません。
 
参照設定ができるようになれば，C++ や C# 等と，少なくとも，同じ土俵には上がれます。

yayadon さんの引用:
上で見たように，今後提供するクラス群は，C++ からでも C# からでも，どちらからでも，それらクラス群が，それら言語にとってネイティブな形で利用できるようになるということです。(VBA はC++側です)
 
非常にセンシティブな話題なので，まともにとらないで欲しいのですが，
.NET無しでの高次元でのプログラミング という世界に移行し始めたということです。
 
今後提供するクラス群は，機能が被るものは，Metro用の .NET Framework から省かれます。
 
C++ は，新しいクラス群が提供する機能は，それらクラスのものを利用し，新しいクラス群が提供しない機能は，Windows API (Win32 API) を利用する。
 
C# は，新しいクラス群が提供する機能は，それらクラスのものを利用し，新しいクラス群が提供しない機能は，.NET Framework のクラスが提供する機能を利用する。それでもやれないことは，Windows API (Win32 API) を利用する。

そういえば，タイプライブラリが用意されていましたね。
　

# 知っている方は，スルーの方向で。
 
 
C++ や VB6 や VBA などで作るオブジェクトと
C# などの .NET系の言語で作るオブジェクトでは，
プログラミング要素群の内，基本的な要素
 
　・スレッド
　・メモリ管理
　・セキュリティ
 
について，やり方が異なっています。
 
 
-----
セキュリティ
 
個人的な考えかもしれませんが，
.NETで作るオブジェクトの利点の内の一つは，
セキュリティ であったと思います。
 
どのように実現したかの説明は省略します。
 
.NETが出てきたころと，現在のセキュリティについて，
Windows という OS において，一番状況が異なるのは，
Vista 以降に，
整合性レベル(integrity level)という概念と仕組みが導入されたことです。
 
この仕組みを使って，
ネイティブ環境で動作するオブジェクトを
ボックス化(外部への呼び出し等を自由にさせないこと)した環境に
閉じ込めることが可能になりました。
 
 
-----
メモリ管理
 
メモリ管理について大きく異なる点は，
ヒープ メモリの使い方にあります。
 
.NETのヒープ メモリの主な使い方の特徴のひとつに
次に利用するメモリの確保の仕方にあります。
以下のようなコイン ロッカー風に見える
 
　□□□□□□□□□□□□□□□□
 
□であらわされたメモリを確保したとします。
(注意: □ が 1バイト を表すという意味ではありません。
　　　4バイト や 8バイト などもっとまとまった範囲を表します。)
 
次に利用する場所を↑で示すと，初期状態は，
 
　□□□□□□□□□□□□□□□□
　↑
 
になります。
 
使用するオブジェクトは三つほど使うとします。 (■ は使用済み を表す)
すると，
 
　■■■□□□□□□□□□□□□□
　　　　↑
 
のように次に利用する場所は移動します。
さらに，もう一つ同じオブジェクトを使うとすると
 
　■■■■■■□□□□□□□□□□
　　　　　　　↑
 
のように次に利用する場所は移動します。
さらに，もう一つ同じオブジェクトを使うとすると
 
　■■■■■■■■■□□□□□□□
　　　　　　　　　　↑
 
のように次に利用する場所は移動します。
最初の3つの■は，実は，もう使用されていないとします。
しかし，GC が起きるまで，回収されないので，
さらに，もう一つ同じオブジェクトを使うとすると
 
　■■■■■■■■■■■■□□□□
　　　　　　　　　　　　　↑
 
のように次に利用する場所は移動します。
最初の3つの■に続いて，次の3つの■も，実は，もう使用されていないとします。
ここで，GC が起きると，最初からの6つは回収されて，
 
　□□□□□□■■■■■■□□□□
　　　　　　　　　　　　　↑
 
のように空きができます。そして，
使用中のメモリを左側に移動させます。次に使う場所を指す矢印も移動します。
 
　■■■■■■□□□□□□□□□□
　　　　　　　↑
 
のような感じになります。
要するに使い方が決まっています。
 
次に使う場所が，あらかじめ決まっているので，
新規オブジェクトの作成に入るまでが速いという特徴があります。
 
 
一方，C++ 側の仕組みは，
 
初期状態は，
 
　□□□□□□□□□□□□□□□□
 
になります。次に利用する場所は特に決まっていませんし，
また，使い方も決まっていません。
 
例えば，4つずつ使おうと決めたとします。
すると，以下のようになります。
 
　□□□□ □□□□ □□□□ □□□□
　↑　　　 ↑　　　 ↑　　　 ↑
 
↑ は，次に使う場所の候補です。
 
使用するオブジェクトは三つほど使うとします (■ は使用済み を表す)
とりあえず最初のものを使うとします。
 
　■■■□ □□□□ □□□□ □□□□
　　　　　 ↑　　　 ↑　　　 ↑
 
↑ は，次に使う場所の候補です。
さらに，もう一つ同じオブジェクトを使うと
 
　■■■□ ■■■□ □□□□ □□□□
　　　　　 　　　　 ↑　　　 ↑
 
のようになり，次に利用する場所の候補は上のようになります。
ここで，最初の3つが使用されていないことになったとします。
 
(注: 実は，
　　この「使用されていないことになった」ということを確定する仕組みが必要になります。
　　・オブジェクトをそもそも共有しないことにする
　　・オブジェクトを渡す時は，常に所有権も渡す
　　・強参照と弱参照の仕組みを利用する
　　・オブジェクトを参照カウント方式で管理する etc.)
 
すると，(注のような何らかの仕組みで) 確定的な回収が行われて，
 
　□□□□ ■■■□ □□□□ □□□□
　↑　　　 　　　　 ↑　　　 ↑
 
のような状態になります。↑ は，次に使う場所の候補です。
さらに，もう一つ同じオブジェクトを使おうとするとき
最初の矢印のものを選んだとします
すると，
 
　■■■□ ■■■□ □□□□ □□□□
　　　　　 　　　　 ↑　　　 ↑
 
のようになります。↑ は，次に使う場所の候補です。
ここで，2つ目のの3つが使用されていないことが確定され，回収されました。
すると，
 
　■■■□ □□□□ □□□□ □□□□
　　　　　 ↑　　　 ↑　　　 ↑
 
のようになります。↑ は，次に使う場所の候補です。
 
あらかじめ，上の例のように，いくつか使う場所を確保しておけば，
その範囲内で済むのならば，非常に効率のよい使い方ができます。
 
個人的な考えですが，
C++側の人たちが，.NETオブジェクトに興味が無いように見える原因の内の一つは，
このあたりにあるんじゃないかと思います。
 
さらに，
.NET が使用するマネージ スレッドの制限からくる違いもあるのですが，
時間が取れるまたの機会にします。
　

話は戻りますが，マコさんからの疑問が入っているので。
 

ふるふる さんの引用:

varptr(Application.ActiveCell),varptr(Application.ActiveCell) 

MsgBox ObjPtr(Application.ActiveCell) = ObjPtr(Application.ActiveCell)
MsgBox ObjPtr(Application.ActiveWorkbook) = ObjPtr(Application.ActiveWorkbook)

'' IUnknownインターフェース用のオブジェクト変数
Dim unk1 As stdole.IUnknown
Dim unk2 As stdole.IUnknown


'' ActiveCellの場合
Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Application.ActiveCell
Set unk1 = rng1    ' Set-型強制 (Set-coercion) つまり QueryInterface
Set rng2 = Application.ActiveCell
Set unk2 = rng2    ' Set-型強制 (Set-coercion) つまり QueryInterface

MsgBox ObjPtr(unk1) = ObjPtr(unk2)     ' (A)


'' ActiveWorkbookの場合
Dim wb1 As Workbook
Dim wb2 As Workbook

Set wb1 = Application.ActiveWorkbook
Set unk1 = wb1    ' Set-型強制 (Set-coercion) つまり QueryInterface
Set wb2 = Application.ActiveWorkbook
Set unk2 = wb2    ' Set-型強制 (Set-coercion) つまり QueryInterface

MsgBox ObjPtr(unk1) = ObjPtr(unk2)     ' (B)

MsgBox Application.ActiveCell Is Application.ActiveCell           ' (a)
MsgBox Application.ActiveWorkbook Is Application.ActiveWorkbook   ' (b)

MsgBox Nothing Is Application.ActiveCell
MsgBox Nothing Is Nothing

yayadonさん、フォロー頂きましてありがとうございました。m(_ _)m

>発言者の意図はわからないので，置いておいて，
>自分が意図したのは，この場合，比べる値は，VarPtr でなく ObjPtr です。
 
すいません、objPtrの間違いです。何か違っている気がしていたのですが思い出せませんでした。
 
ここではなされている内容は、かいつまんで言うと、オブジェクトつまりクラスのインスタンスはある一定のメモリ領域を占有し、二つの変数がそれぞれ同一のメモリ領域を示しているならば、同一のインスタンスである、ということですよね。
それは正しいのですが、あるクラスの二つのインスタンスが同じである、という意味はクラスのメンバーが全て同じ値である、という場合もあるかと思うのです。
この場合、二つのインスタンスは同一ではない（片方のインスタンスのメンバーの値を変えると同一性が失われる）けど、内容は同じ。　こういう場合のための比較方法というのは、今のところ自分でメソッドを作らないといけないといけないでしょうけど、一般的ではないのでしょうかね？
 
 

今までの話の流れと無関係です。すみません。
 
CELLの値とリアルタイムに表示が連動するUserForm用コントロール
http://www.moug.net/faq/viewtopic.php?t=60582
 
クラスについて。
 
既存のクラスを参考にするとよいと思います。
Range、FileSystemObject、Collection、Dictionary、すべてクラスです。
 
・どのようなメンバ(メソッド、プロパティ、イベントのこと)があるか
・何を1個のクラスとしているか
 
参考になると思います。

ふるふる さんの引用:
二つのインスタンスは同一ではない（片方のインスタンスのメンバーの値を変えると同一性が失われる）けど、内容は同じ。　こういう場合のための比較方法というのは、今のところ自分でメソッドを作らないといけないといけないでしょうけど、一般的ではないのでしょうかね？

・Excel 2010 x64でのメソッドのフック例
 
初回のMsgBox

---------------------------
Microsoft Excel
---------------------------
エラー 438
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
---------------------------
OK   
---------------------------

---------------------------
Microsoft Excel
---------------------------
エラー 438
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
---------------------------
OK   
---------------------------

test.xlsm のIDispatch::Invoke (DispId=&HAF) が呼ばれました
test.xlsm のIDispatch::Invoke (DispId=&HAF) が呼ばれました
test.xlsm のIDispatch::Invoke (DispId=&HAF) が呼ばれました
↑実行時バインディング時はInvokeが２度呼ばれので。

Option Explicit
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Any, _
        ByVal dwSize As LongLong, _
        ByVal flNewProtect As Long, _
        lpflOldProtect As Long) As Long
Const PAGE_EXECUTE_READWRITE = &H40
Private Declare PtrSafe Sub CopyLongPtr Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, _
        Optional ByVal Length As LongLong = 8)
Private Declare PtrSafe Function DispCallFunc Lib "oleaut32" _
        (ByVal pvInstance As LongPtr _
        , ByVal oVft As Long, _
        ByVal cc As Long, ByVal vtReturn As Integer, _
        ByVal cActuals As Long, prgvt As Integer, _
        prgpvarg As LongPtr, _
        pvargResult As Variant) As Long
Const CC_STDCALL = 4
Const DISP_E_MEMBERNOTFOUND = &H80020003
Const S_OK = &H0&
Const DISPID_SAVECOPYAS = &HAF&
 
Private m_pProc As LongPtr ' フックプロシージャのアドレス
Private m_PrevProc As LongPtr ' 以前の関数ポインタ
Private m_pVtbl As LongPtr ' 関数ポインタをセットしたアドレス
 
 ' フックプロシージャ(DISPID or 実行時バインド用)
Private Function InvokeProc( _
        ByVal This As Object, _
        ByVal dispIdMember As Long, _
        ByVal riid As Long, ByVal lcid As Long, _
        ByVal wFlags As Integer, ByVal pDispParams As LongPtr, _
        ByVal pVarResult As LongPtr, _
        ByVal pExcepInfo As LongPtr, _
        ByVal puArgErr As LongPtr) As Long
On Error Resume Next

    Const PARAMCOUNT = 8
    Dim Args() As Variant
    Dim pArgs(0 To PARAMCOUNT - 1) As LongPtr
    Dim vt(0 To PARAMCOUNT - 1) As Integer
    Dim vntResult As Variant
    Dim pObj As LongPtr
    Dim i As Long
    Dim hr As Long
    Dim wb As Workbook
 
     If dispIdMember = DISPID_SAVECOPYAS Then
        Set wb = This
        Debug.Print wb.Name; " の";
        Set wb = Nothing
        Debug.Print "IDispatch::Invoke (DispId=&H" & _
                 Hex$(dispIdMember) & ") が呼ばれました"
 
         ' 戻り値で実行時エラーを発生させる
        ' (エラーにしたくなければ S_OK に変更)
        InvokeProc = DISP_E_MEMBERNOTFOUND
        Exit Function
    End If
 
     ' フック対象以外なら引き続き 本来のInvokeメソッドを呼び出す
 
     Args = VBA.Array(dispIdMember, riid, lcid, wFlags, pDispParams, _
                     pVarResult, pExcepInfo, puArgErr)
    For i = 0 To PARAMCOUNT - 1
        vt(i) = vbLongLong
        pArgs(i) = VarPtr(Args(i))
    Next
    'vt(3) = vbInteger
    pObj = ObjPtr(This)
 
     ' 再帰呼び出しの発生に注意
    EndInvokeHook
    hr = DispCallFunc(pObj, 8 * 6, CC_STDCALL, vbLongLong, _
                      PARAMCOUNT, vt(0), pArgs(0), vntResult)
    StartInvokeHook
    If hr < 0 Then
        InvokeProc = hr
    Else
        InvokeProc = vntResult
    End If
 
End Function

' メモリ上の指定されたアドレスに64ビット値を書き込み
Private Function ForceCopyLongPtr(ByVal Address As LongPtr, _
                           ByVal Value As LongPtr) As Boolean
    Dim lngOld As Long
    If VirtualProtect(Address, 8, _
                      PAGE_EXECUTE_READWRITE, lngOld) = 0 Then
        Exit Function
    End If
    CopyLongPtr ByVal Address, Value
    VirtualProtect Address, 8, lngOld, lngOld
    ForceCopyLongPtr = True

End Function
 
' フック開始 (DISPID or 実行時バインド用)
Sub StartInvokeHook()

    Dim unk As stdole.IUnknown
    Dim wb As Workbook
    Dim obj As Object
    Dim pObj As LongPtr
    Dim pVtbl As LongPtr
    If m_pVtbl Then Exit Sub ' すでに開始している
 
     ' 内側にあるWorkbookオブジェクトの参照を取得
    Set unk = ThisWorkbook
    Set wb = unk
    Set obj = wb ' 念のため
    CopyLongPtr pObj, obj 'pObj=ObjPtr(obj)
    'If pObj = 0 Then Exit Sub
 
     CopyLongPtr pVtbl, ByVal pObj
    pVtbl = pVtbl + 8 * 6 ' Invokeメソッドのオフセット

    CopyLongPtr m_PrevProc, ByVal pVtbl ' 以前のポインタを退避
    m_pProc = VBA.CLngPtr(AddressOf InvokeProc)

    If Not ForceCopyLongPtr(pVtbl, m_pProc) Then Exit Sub
    m_pVtbl = pVtbl
 
End Sub

' フック終了
Sub EndInvokeHook()

    Dim p As LongPtr
    If m_pVtbl = 0 Then Exit Sub
    CopyLongPtr p, ByVal m_pVtbl
    If p = m_pProc Then ' 念のためのチェック
        ForceCopyLongPtr m_pVtbl, m_PrevProc
    End If
    m_pVtbl = 0
 
End Sub
 

Sub test()
 
    Dim wb As Workbook
    Dim obj As Object
    Set obj = ThisWorkbook
    Set wb = obj
 
    StartInvokeHook
    On Error GoTo Err_Handler
    obj.SaveCopyAs "C:\テスト02.xls" ' 実行時バインド
    wb.SaveCopyAs "C:\テスト01.xls" ' 事前バインド
    EndInvokeHook
 
    'obj.SaveCopyAs "C:\これは保存される.xls"
    Exit Sub
Err_Handler:
    MsgBox "エラー " & Err.Number & vbLf & Err.Description, vbCritical
    Resume Next
 
End Sub

DispCallFunc の宣言のところの ByVal oVft As Long
も LongPtr なのでは？

> ↑実行時バインディング時はInvokeが２度呼ばれので。
これはExcelの話なので。
  
http://msdn.microsoft.com/en-us/library/ms221473%28v=vs.85%29.aspx

HRESULT DispCallFunc(
  void *pvInstance,
  ULONG_PTR oVft,
  CALLCONV cc,
  VARTYPE vtReturn,
  UINT cActuals,
  VARTYPE *prgvt,
  VARIANTARG **prgpvarg,
  VARIANT *pvargResult
);

CreateObject("Shell.Application").ShellExecute "excel.exe", """" & ThisWorkbook.FullName & """", vbNullString, "runas", 1
ThisWorkbook.Saved = True
Application.Quit

・LongLong型だと無理なお話

---------------------------
Microsoft Visual Basic for Applications
---------------------------
コンパイル エラー:

型が一致しません。
---------------------------
OK   ヘルプ   
---------------------------

    Dim tmp1^(0 To 5103^) 'NG
    Dim tmp2^(0 To 5103@) 'OK
    Dim tmp3^(0 To 5103#) 'OK

割込み、失礼します。
 
コード作成関係のネタですが、こんな話はどうでしょうか。
http://en.wikipedia.org/wiki/Hofstadter_sequence
に　Hofstadter Female and Male sequences　というのが定義されています。
 
F(0) = 1
M(0) = 0
F(n) = n - M(F(n-1)) (n>0のとき）
M(n) = n - F(M(n-1)) (n>0のとき）
上記で二つの系列 F, M を定めます。
 
M(200)を単純な再帰で求めようとすると
結構時間がかかります。40秒くらい。
このとき、M(10000)を求めてください。
# すぐに回答が出てしまうかもしれません。

simple さんの引用:
このとき、M(10000)を求めてください。

私からもクイズ。
 
「プログラマーはハロウィンとクリスマスを区別できない。なぜだろう」
 
Twitterで流れてきました。
答えもそこに書いてあるので検索すればすぐわかりますが、面白かったので。

>このとき、M(10000)を求めてください。
 
単純な再帰プログラムだと、スタックエラーになるかも。M(200)でも１分以上かかったので。なのでこれは答えではないです。

Option Explicit

Function Female(n)
    If n = 0 Then
        Female = 1
    Else
        Female = n - Male(Female(n - 1))
    End If
End Function

Function Male(n)
    If n = 0 Then
        Male = 0
    Else
        Male = n - Female(Male(n - 1))
    End If
End Function

Sub Calc()
    Dim num As Integer
    num = InputBox("Input M(Integer)?")
    MsgBox Male(num)
End Sub

ふるふる さんの引用:
単純な再帰プログラムだと、スタックエラーになるかも。M(200)でも１分以上かかったので。なのでこれは答えではないです。

ふるふる さんの引用:
>「プログラマーはハロウィンとクリスマスを区別できない。なぜだろう」
「エキスパートＣプログラミング」で読んだネタだったかな。

月さん、ふるふるさん、コメントありがとうございました。
 
この場合、小さい方から確定していけばよいのは、
ご指摘のとおりです。
 
実は関数型プログラミング言語の本で、なかなかおもしろいと
思ったので、以下紹介します。
テーマの趣旨を説明することで、責めを果たしたいと思います。
 
(1)
相互再帰の形を保ったままで、性能を上げることを考えます。
こうした場合によく使われるのが、
メモ化(memoization)という手法です。
http://ja.wikipedia.org/wiki/%E3%83%A1%E3%83%A2%E5%8C%96
 
これは、一度計算した結果はdictionaryあたりに保存しておいて、
次に呼ばれた時は計算せずに返すという方法です。
 
male と female それぞれの頭で、dicに n が存在していたら、
値を返して、exitします。
逆に、それぞれの最後では、dicに登録します。
 
これで、相当スピードはあがります。
(2)
しかし、これだけだと、ふるふるさんから指摘がありましたように、
n = 4000 近くで、stack overflowになると思います。
 
それで、これを回避するには、dicによるキャッシュが
頭から計算されるようにすることです。
 
具体的には、小さいnから計算していくことになります。
コードは示しませんが、こんな考え方で、再帰の形で実行が可能です。
 
ちなみに　m(10000)は 6180 です。
 
------------------------
以下は余談です。スキップいただいて結構です。
 
(3)
memoizationはコードのなかでロジックを組み込むことが普通でしょうけど、
ある種の関数型言語（以下、clojureの例です）では、
ロジックを書かなくても ふるふるさんと同様な機能を持つ関数 man に対し、
  (def man (memoize man) )
のようにすることで、関数 man にメモ化機能を組み込むことが可能です。
 
また、遅延評価の機能を持つ言語では、
  (iterate inc 0) で 0から始まる無限数列 を定義しておいて、
その自然数列に対して、無限数列を返すメソッド man-seq を
  (def man-seq (map man (iterate inc 0)) )
のように定義することができます。
 
この数列の100 番目を取り出したいときは、
  (nth man-seq 100)
を実行すると、この時点で初めて100番目までが実行されます。
101番目以降は実際に呼ばれるまでは実行されません。
（こうした仕組みが、遅延評価と呼ばれているようです。）
 
読みかじり状態で、本当に大胆だと思いますが、簡単な紹介まで。

simple さんの引用:
m(10000)は 6180 です。

月 さんの引用:
「プログラマーはハロウィンとクリスマスを区別できない。なぜだろう」

どちらでもいいことに属しますが、前の発言で、
> 無限数列を返すメソッド man-seq
と書いたのはデタラメで、man-seq は単なるsequenceの書き間違いでした。
訂正させていただきます。
 
「OCT 31 = DEC 25」 は私も閲覧中のtwitterで目にしました、なるほど、と。
書籍にもネタとして使われていた由緒あるものとは知りませんでした。
# でも仏教徒の私には縁遠い風習で・・・。

質問でなくて報告なので、こちらで。
 
Abyssさんお勧めのSetWindowSubclassのマシン語による使用結果です。
http://www.moug.net/faq/viewtopic.php?t=60887
A ↓エクセルがコケます。

	cmp edx, 20Ah  ;WM_MOUSEWHEEL
	jnz label
	xor rax, rax
	ret
label:
	mov r10, 1111111111111111h ;DefSubclassProc
	sub rsp, 32
	call r10
	add rsp, 40
	ret

	sub rsp, 56
	cmp edx, 20Ah  ;WM_MOUSEWHEEL
	jnz label
	xor rax, rax
	add rsp, 56
	ret
label:
	mov r10, 1111111111111111h ;DefSubclassProc
	call r10
	add rsp, 56
	ret

Option Explicit

Private Declare PtrSafe Function SetWindowSubclass Lib "ComCtl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As Long
Private Declare PtrSafe Function RemoveWindowSubclass Lib "ComCtl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As LongPtr)
Private Declare PtrSafe Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Any, ByVal dwSize As LongPtr, ByVal flAllocationType As Long, ByVal flProtect As Long) As LongPtr
Private Declare PtrSafe Function VirtualFree Lib "kernel32" (ByVal lpAddress As Any, ByVal dwSize As LongPtr, ByVal dwFreeType As Long) As Long
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleW" (ByVal lpModuleName As LongPtr) As LongPtr
Const MEM_TOP_DOWN = &H100000
Const MEM_RELEASE = &H8000&
Const PAGE_EXECUTE_READWRITE = &H40&
Const MEM_RESERVE = &H2000&
Const MEM_COMMIT = &H1000&

Private vp As LongPtr '実行可能コードへのポインタ
Const n1 = 22& 'DefSubclassProc

Sub starteHook()

    Const code$ = "020AFA8138EC834848C03148087500001111BA49C338C483FF411111111111119090C338C48348D2"
    Dim hWnd As LongPtr, WndPtr As LongPtr, funcPtr As LongPtr
    Dim i&, j&, UB&, length&, slen&
    Dim lnglngCode^()

    vp = 0^  '初期化

    hWnd = Application.hWnd
    slen = Len(code)
    UB = slen \ 16
    length = slen + 1
    ReDim lnglngCode(0 To UB - 1)
    
    For i = 1 To slen Step 16
        lnglngCode(j) = "&H" & Mid$(code, i, 16)
        j = j + 1
    Next

    '実行可能属性を持った領域を確保。
    vp = VirtualAlloc(0&, length, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    CopyMemory ByVal vp, lnglngCode(0), length

    funcPtr = GetProcAddress(GetModuleHandle(StrPtr("comctl32")), "DefSubclassProc")
    CopyMemory ByVal vp + n1, funcPtr, 8

    'サブクラス化開始
    SetWindowSubclass hWnd, vp, hWnd, 0

    
End Sub


Sub endHook()

    Dim hWnd As LongPtr
    hWnd = Application.hWnd
    
    'サブクラス化終了
    RemoveWindowSubclass hWnd, vp, hWnd
    VirtualFree vp, 0, MEM_RELEASE

End Sub

SetWindowSubclassとDefSubclassProc関数は最初の4パラメーターが
一致しますね。であれば、x64環境では jmp命令でいい気がします。
 

	cmp dx, 20Ah  ;WM_MOUSEWHEEL
	jnz label
	xor rax, rax
	ret
label:
	mov r10, qword 0h ;DefSubclassProc
	jmp r10

こんにちは。
もうひとつこんな問題はいかがでしょう。
 
"X10Y1","X10Y10","X10Y2","X1Y1","X1Y10","X1Y2","X2Y1","X2Y10","X2Y2"
という配列を
"X1Y1", "X1Y2", "X1Y10", "X2Y1", "X2Y2", "X2Y10", "X10Y1", "X10Y2", "X10Y10"
のように、
文字部分と数字部分に分けた場合の順序に従ってソートしてください。
 
上記は（数字以外の）文字部分と数字部分のペアが2つですが、
n個でも対応できるようなものを考えて下さい。
正規表現ということになるのでしょうか。
なお、
数字が無い場合もあります。この場合は、例えば、
z1A, z1B, z12, z13, zAB という順序になります。
# もちろん出典はありますが、あえて書きません。

Abyssさん、クロスアセンブルまでして頂きまして、
ありがとうございました。
(先のAと変わらず、Excelにメッセージが飛んだ瞬間、コケます)
 
ーーー
こちらを読みまして、即値の指定の仕方を思いついたのですが、
http://www.nasm.us/doc/nasmdo11.html
> 1111111111111111h
と同じ事の様で。
 
結果、上記のBと変わらず。

	sub rsp, 56
	cmp dword edx, 20Ah  ;WM_MOUSEWHEEL
	jnz label
	xor rax, rax
	add rsp, 56
	ret
label:
	mov qword r10, qword 0  ;DefSubclassProc
	call qword r10
	add rsp, 56
	ret

ダメでしたかぁ。
 
64ビットOSでもMicrosoft側がOfficeインストールは32ビットを推薦する
（規定では32ビットInstallらしいですね）理由がTypeLibraryやActiveXの互換性の
問題が存在するに加わって、もし今回の検証方法が正しければこれも
もう一つの問題点ですかね。今のところ、64ビット環境に魅力を感じない
私としては、成功例を見てみたいだけですね。
 
お陰様で、Assemblyの「Microsoft FASTCALL Convention」の勉強をする
きっかけになりました。ありがとうございます。

Abyssさん、コメントありがとうございました。
# 私も出来るのか、そもそも不可能なのかそれだけでも知りたいですね。

x64のMASMでも同様なのを確認しました。
(これ以上の展開もありませんので)
# simpleさん、お邪魔しました。

>お邪魔しました。
いえいえ、お邪魔しているのはこちらです。
 
あまり食指が動かないテーマだったでしょうか。
実は、この話は、色々な言語を使って、どれが短く、すっきり書けるか、
ネットで議論されていたものです。
「数字混じり文字列ソート」で検索するとヒットします。
 
以下では、VBAのコードは挙げていません。次回以降にします。
関係乏しい話で恐縮です。でも実用一辺倒でなくてもよろしいかと。
お急ぎのかたは、以下すべてスキップ願います
-------------------------
オブジェクト指向言語Rubyを使ったものが一番短く書けるようですね。
はじめから横道に逸れて恐縮ですが、最初にそれを紹介しましょう。　
 

class Array
    def mixed_sort
        sort_by{|s| 
           s.scan(/(\d+)|([^\d]+)/).map{|a|
               a[1] || a[0].to_i
           }
        } 
    end
end

ary = ["X10Y1","X10Y10","X10Y2","X1Y1","X1Y10","X1Y2","X2Y1","X2Y10","X2Y2"]
p ary.mixed_sort
# =>  ["X1Y1", "X1Y2", "X1Y10", "X2Y1", "X2Y2", "X2Y10", "X10Y1", "X10Y2", "X10Y10"] が出力されます。

   sort_by{|s| 
      s.scan(/(\d+)|([^\d]+)/).map{|a| 
          a[1] || a[0].to_i
      }
   }

     s.scan(/(\d+)|([^\d]+)/).map{|a| 
            a[1] || a[0].to_i
      }

配列の要素      ソートの判定に使われる配列
----------      --------------------------
"X10Y1"    　　　[ "X", 10 , "Y",  1 ] 
"X10Y10"         [ "X", 10 , "Y", 10 ] 
・・・・・・・
"X2Y2"           [ "X",  2 , "Y",  2 ]  

コメントがないので、私案をあげてみます。
反則かもしれませんけど、JScriptのSortメソッドを使いました。
 
この場合、SortにSortfunctionをどうやって与えるか不明なので、
その場しのぎの方法で数字も文字列として大小比較することにしました。
もっと良い方法がありましたら、ご教示くださいまし。
 

Sub test()
    Dim ary
    Dim re As Object
    Dim matches, m
    Dim s
    Dim myDigit As String, myStr As String
    Dim k As Long
    Dim p As Long
    Dim mat() As String
    Dim sc As Object
    Dim myList, temp
    Dim x

    ary = Array("X10Y1", "X10Y10", "X10Y2", "X1Y1", _
                "X1Y10", "X1Y2", "X2Y1", "X2Y10", "X2Y2")
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(\d+)|(\D+)"
    re.Global = True

    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"

    ' myList ; ary の各要素について、
    '          数字と文字に分離したものからなる配列
    '            (ただし､最後に要素そのものを追加)
    '          を要素とする配列
    Set myList = sc.eval("new Array()")
    For Each s In ary
        Set matches = re.Execute(s)
        p = 1
        Set temp = sc.eval("new Array()")
        For Each m In matches
            myDigit = m.submatches(0)
            myStr = m.submatches(1)
            p = p + 1
            If Len(myDigit) = 0 Then
                temp.push myStr
            Else
                temp.push Right(String(10, "0") & myDigit, 10)
            End If
        Next
        temp.push s
        myList.push temp
    Next

    '配列をソート
    CallByName myList, "sort", VbMethod

    '結果を配列にセット
    ReDim mat(UBound(ary))
    p = 0
    For Each x In myList
        mat(p) = CallByName(x, "pop", VbMethod)  '最後の項目を取得
        p = p + 1
    Next
    Stop
End Sub

> x64のMASMでも同様なのを確認しました。
 
それなら、Excel固有の問題ではなく、アセンブリの
組み方に問題があると私は解釈したいですけど。

こんにちは。
>「数字混じり文字列ソート」
XP以降（？）だと Function StrCmpLogicalW Lib "SHLWAPI.DLL" で判定してSortもありでしょうか。

nさん ありがとうございました。
なるほど、そういうAPIがあるんですか、知りませんでした。
PHPにもそのままのメソッドがあるようでした。
 
ところで、具体的にどう書いたらいいでしょうか。
JScript側でも自由にAPIの関数が呼べるのでしょうか。
JScriptを使うという提案じゃないのかな？
ご教示いただければ幸いです。
 
Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long
と宣言し、
    sc.AddCode "function comp(x, y){return StrCmpLogicalW(x,y);}"
としたうえで、
    CallByName myList, "sort", VbMethod, sc.CodeObject.comp
などとしても、CallByNameのところで、
アプリケーション定義またはオブジェクト定義のエラーとなります。
JScript側でStrCmpLogicalWを使うことを宣言している訳ではないんでしょうから、
当然と言えるのでしょうけど。

simpleさんらしくないですね。

int StrCmpLogicalW(
  __in  PCWSTR psz1,
  __in  PCWSTR psz2
);

すみません、単純にSort時の比較の話でした。

Option Explicit
Private Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" ( _
                                        ByVal lpStr1 As String, _
                                        ByVal lpStr2 As String) As Long
Sub test()
    Dim i   As Long
    Dim j   As Long
    Dim mx  As Long
    Dim tmp As String
    Dim ary

    ary = VBA.Array("X10Y1", "X10Y10", "X10Y2", "X1Y1", _
                    "X1Y10", "X1Y2", "X2Y1", "X2Y10", "X2Y2")
    mx = UBound(ary)
    For i = 0 To mx - 1
        For j = i + 1 To mx
            If StrCmpLogicalW(StrConv(ary(i), vbUnicode), _
                              StrConv(ary(j), vbUnicode)) > 0 Then
                tmp = ary(i)
                ary(i) = ary(j)
                ary(j) = tmp
            End If
        Next
    Next
    Debug.Print Join(ary, vbLf)
End Sub

# ただ今、帰宅しました。
ご指摘ありがとうございます。
StrPtr は UNICODE文字列バッファーのアドレスを返すので、
この返り値をStrCmpLogicalWの引数にする、ということですかね。
引数の話以前のJScriptとの連携に気をとられて、テキトーでした。
失礼しました。
 
nさん、コードの提供ありがとうございました。やはり直に書いたほうが簡潔ですね。
この比較の場合はこれがベストでしょうね。
 
私の元々の意図は、正規表現の利用、一般的な各種比較関数によるソートということだったのですが、
この方向では、VBAはRubyより冗長にしかならないと思います。
できるだけ簡潔な記述で利用できるようなクラスを工夫しておくと
いった対応が考えられるでしょうか。
 
終わりにもう少し、どなたかご存じでしたら教えてください。
(1)
JScriptとWinAPIとの連携というのは可能なものですか？
(2)
qsort に比較関数を与えるのと同様に、
比較関数を取り替えるようなことをするには、
一般的にはどのようにするのでしょうか。
関数ポインタのようなものを簡単に扱う方法はありますか？
 
やはり、sort本体と、比較関数を切り分け、
比較関数はクラスのメソッドとして実現し、
sortの引数にはそのクラスのインスタンスを渡す方式でしょうか。
比較関数を変える場合は、その都度implementsして
別のクラスを作成していくという方法でしょうか。
（Rubyのブロックは、そのあたりが非常に簡便にできて便利です。）

kumattiさんからご指摘いただいた方法を
nさんのコードで使用すると結果が異なります。
StrPtrを使用する場合は、宣言が変わってくるのかと想像します。
StrPtrを使用する場合の宣言を参考までに教えて下さい。
基本的なことですみません。

PCWSTR型を別の書き方をすると、 const WCHAR*型です。
 
なので、nさんの宣言で言えば

Private Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" ( _
                                        ByVal lpStr1 As Long, _
                                        ByVal lpStr2 As Longg) As Long

ありがとうございました。動作確認できました。

失礼。Longgになっていました。
 > JScriptとWinAPIとの連携というのは可能なものですか？
http://kinuasa.wordpress.com/2011/04/17/vbscript%E3%81%8B%E3%82%89windows-api%E9%96%A2%E6%95%B0%E3%82%92%E5%91%BC%E3%81%B3%E5%87%BA%E3%81%99/
このAPIがStrCmpLogicalW を指すなら、
Unicode文字列へのポインタをどうSCript側から渡すのか難しいと思います。

> SCript側から渡すのか難しい VBA上なら、関係無かったですね。

StrCmpLogicalW関数の代わりとなる関数を書いてみました。
サンプルコードはnさんのコードを利用させていただきました。
バグがないといいのですが(汗)
https://gist.github.com/1366050

kumatti さん、丁寧な応答、ありがとうございました。
 
月さん　どうもありがとうございました。
おかげで、APIに依存しない方法が完成したものと思います。
 
ついでに余談で、しかもRuby話で恐縮です。お急ぎのかたは、例によってスキップ下さい。
以前書いたシュワルツ変換というのはこういう話です。
ファイルをその更新時刻でソートしようという例で考えると、

files = Dir["*"]
sorted = files.sort{|a,b| File.new(a).mtime <=> File.new(b).mtime}

files = Dir["*"].map{ |f|
   [test(?M,f),f]
}.sort.map{|f| f[1]}

simple さんの引用:
今回の例も、
Set m(0) = Reg.Execute(a)
を何度も繰り返すので、節約しようなどという気にもなるのですが、

Sub test2()
    Dim ary
    Dim Reg As RegExp
    Dim m As MatchCollection

    ary = VBA.Array("X10Y1", "X10Y10", "X10Y2", "X1Y1", _
                    "X1Y10", "X1Y2", "X2Y1", "X2Y10", "X2Y2")
    
    Set Reg = New RegExp
    Reg.Global = True
    Reg.MultiLine = True
    Reg.pattern = "^(\d+|[^\n\d]+)+$"
    Set m = Reg.Execute(Join(ary, vbLf))
    Stop
End Sub

月 さんの引用:
ちなみに、mixedCompare関数を少し修正しました。
変更後のコードのURLは変わりませんが、変更前のコードのURLはこちらです。
https://gist.github.com/1366050/82fdfe7663f6e2cdb1c72766e0e02e9cddb99415

・JScriptのtypeofの例

var o = new ActiveXObject("Excel.Application");
o.visible = true;
o.Workbooks.Open("任意のパス");//\→\\
WScript.Echo(typeof(o.Application.ThisWorkbook) + '\t' + typeof(o.Application.Workbooks(1)));
WScript.Quit();

# 古い話で恐縮なんですが...
Integerのオーバーフロー絡みの一連の話について，まとめてみました。
  
例えば，
 

引用:
(任意の整数型) / (任意の整数型) -> Double 型になります。

Dim obj As Object
   略
Set obj = Nothing

# 基本に興味のある方向け
 
VBA では，Variant 型のある仕組みについて，
あまり取り上げられていないような気がします。
もしくは，ただ単に意識していないだけかもしれません。
 
その仕組みに迫ってみたいと思います。
 
 
-----
ByRef 渡し と Variant型
 
 
まず初めに，以下のような，
長整数型(Long)で，値を 参照渡し(ByRef) するプロシージャを見てみます。
どんな値を渡されても，100 にしてしまうという意味のないものです。
 

Private Sub TestByRefLong(ByRef lngValue As Long)

    lngValue = 100   '何が渡ってきても，100 にする。

End Sub

Private Sub Test1()

    Dim lngValue As Long
    lngValue = 1
    TestByRefLong lngValue
    MsgBox lngValue             '(3)

End Sub

Private Sub TestByRefLong(ByRef lngValue As Long)

    MsgBox VarPtr(lngValue)    '(2) 仮引数 (formal parameter) のアドレス値
    lngValue = 100             '何が渡ってきても，100 にする。

End Sub

Private Sub Test1()

    Dim lngValue As Long
    lngValue = 1
    MsgBox VarPtr(lngValue)    '(1) 実引数 (argument) のアドレス値
    TestByRefLong lngValue
    MsgBox lngValue

End Sub

Private Sub TestByRefLong(ByRef lngValue As Long)

    MsgBox VarPtr(lngValue)    '(2)
    lngValue = 100   ' 何が渡ってきても，100 にする。

End Sub

Private Sub Test2()

    Dim lngValue As Long
    lngValue = 1
    MsgBox VarPtr(lngValue)       '(1)
    TestByRefLong lngValue + 1    '<--- 演算結果を渡す
    MsgBox lngValue               '(3) <--- 当然 100 には，ならない。

End Sub

Private Sub TestByRefLong(ByRef lngValue As Long)

    lngValue = 100   '何が渡ってきても，100 にする。

End Sub

Private Sub Test3()

    Dim intValue As Integer     'この型だけ Integer に変更
    intValue = 1
    TestByRefLong intValue
    MsgBox intValue

End Sub

Private Sub TestByRefVariant(ByRef vntValue As Variant)

    MsgBox VarPtr(vntValue)    '(2)
    vntValue = 100             '何が渡ってきても，100 にする。

End Sub

Private Sub Test4()

    Dim vntValue As Variant
    vntValue = 1
    MsgBox VarPtr(vntValue)    '(1)
    TestByRefVariant vntValue
    MsgBox vntValue            '(3) 100 になる。

End Sub

Private Sub TestByRefVariant(ByRef vntValue As Variant)

    MsgBox VarPtr(vntValue)    '(2)
    vntValue = 100             '何が渡ってきても，100 にする。

End Sub

Private Sub Test5()

    Dim lngValue As Long
    lngValue = 1
    MsgBox VarPtr(lngValue)    '(1)
    TestByRefVariant lngValue
    MsgBox lngValue            '(3) 100 になる。

End Sub

# 時間がとれたので
# ByRef 引数 を整理してみます。
 
具体的なコードは，最後に Class1 クラスのプロパティ/メソッドとして示します。
読んでいて，よくわからない場合は，
先にコードを走らせてみるのもいいかもしれません。
 
 
◆ 型が同じ変数を直接渡された場合
 

-------------------------------
　  Dim lngValue As Long      実引数
           ↑参照
　ByRef refValue As Long      仮引数
-------------------------------
　　Dim vntValue As Variant   実引数
　　　　　 ↑参照
　ByRef refValue As Variant　 仮引数
-------------------------------

--------------------------------------
　  Dim lngValue As Long        実引数
　　　　　 ↓代入
　　Dim tmpValue As Long　　    一時変数
           ↑参照
　ByRef refValue As Long        仮引数
--------------------------------------
　　Dim vntValue As Variant     実引数
　　　　　 ↓代入
　　Dim tmpValue As Variant　   一時変数
　　　　　 ↑参照
　ByRef refValue As Variant     仮引数
--------------------------------------

--------------------------------------
　  Dim intValue As Integer  ← 例えば，Integer の時
　　
　ByRef refValue As Long     ← 例えば，Long の時
--------------------------------------

--------------------------------------
　　Dim lngValue As Long     ← 例えば，Long の時
　　　　　 ↑参照
　　Dim tmpValue As Variant　一時変数
　　　　　 ↑参照
　ByRef refValue As Variant
--------------------------------------

Dim lngValue As Long
Dim vntValue As Variant

lngValue = 1
vntValue = lngValue

--------------------------------------
　　Dim lngValue As Long       実引数  例えば，Long の時
　　　　　 ↑
　　Dim tmpValue As Variant　  一時変数は，参照フラグ が立っている。
　　　　　 ↑
　ByRef refValue As Variant    仮引数
--------------------------------------

Private Sub TestByRefVariant(ByRef vntValue As Variant)

    MsgBox VarPtr(vntValue)    '(2)
    vntValue = 100             '何が渡ってきても，100 にする。

End Sub

Private Sub Test5()

    Dim lngValue As Long
    lngValue = 1
    MsgBox VarPtr(lngValue)            '(1)
    TestByRefVariant lngValue + 1      '演算結果を渡す
    MsgBox lngValue                    '(3) 100 になる。

End Sub

--------------------------------------------
　　Dim lngValue As Long     ← 例えば，Long の時

　　　　lngValue + 1
           ↓                ← 演算結果の代入(つまり，値のコピー)
　　Dim tmpValue As Variant　一時変数は，参照フラグ が立っていない。
　　　　　 ↑
　ByRef refValue As Variant
--------------------------------------

-------------------------------------
　　Dim lngValue As Long                ← 例えば，Long の時
   オブジェクト参照.Value = lngValue
  ----------------------------------
　　　　lngValue 
           ↓                ← 演算結果の代入(つまり，値のコピー)
　　Dim tmpValue As Long 　  一時変数
　　　　　 ↑
　ByRef refValue As Long     ← 例えば，ByRef Long の時
-------------------------------------------------------------------

　　Dim vntValue As Variant              ← 例えば，Variant の時
   オブジェクト参照.Value = vntValue
   -------------------------------------
　　　　vntValue
           ↓                ← 演算結果の代入(つまり，値のコピー)
　　Dim tmpValue As Variant　一時変数は，参照フラグ が立っていない。
　　　　　 ↑
　ByRef refValue As Variant     ← 例えば，ByRef Variant の時
-------------------------------------------------------------------

　　Dim lngValue As Long     ← 例えば，Long の時
   オブジェクト参照.Value = vntValue
  ----------------------------------
　　　　lngValue
           ↓                ← 演算結果の代入(つまり，値のコピー)
　　Dim tmpValue As Variant　一時変数は，参照フラグ が立っていない。
　　　　　 ↑
　ByRef refValue As Variant
-------------------------------------------------------------------

'' Class1 クラスモジュール
Option Explicit

'プロパティ  ByRef Long
Public Property Let PropertyLongByRef(ByRef refValue As Long)

    refValue = 100      '参照先は一時変数なので，値は反映されません。

End Property

'メソッド   ByRef Long
Public Sub MethodLongByRef(ByRef refValue As Long)

    refValue = 100      '直接渡された変数ならば，値は反映されます。

End Sub

'プロパティ   ByRef Variant
Public Property Let PropertyVariantByRef(ByRef refValue As Variant)

    refValue = 100      '参照先のVariant型一時変数には 参照フラグは立ちません。
                        'なので，値は反映しません。

End Property

'メソッド   ByRef Variant
Public Sub MethodVariantByRef(ByRef refValue As Variant)

    refValue = 100      '参照先のVariant型一時変数には 参照フラグが立ちます。
                        'なので，値は反映されます。

End Sub

Private Sub Test6()

    Dim myClass As Class1
    Dim lngValue As Long
    Dim vntValue As Long

    Set myClass = New Class1

    lngValue = 1
    myClass.PropertyLongByRef = lngValue
    MsgBox lngValue                           ' 1 のまま

    lngValue = 1
    myClass.MethodLongByRef lngValue
    MsgBox lngValue                           ' 100 になっている

    vntValue = 1
    myClass.PropertyVariantByRef = vntValue
    MsgBox vntValue                           ' 1 のまま

    vntValue = 1
    myClass.MethodVariantByRef vntValue
    MsgBox vntValue                           ' 100 になっている

End Sub

補足
 

yayadon さんの引用:

上で，ByRef 引数 が，一時変数への参照 であるように表現していますが，
仕様書上のセマンティクス的には，
それら２つをあわせて，
プロシージャ内のローカル変数のようなスコープの扱い※2になっています。
どのように実装するかは，決められていなく，
その変数/値が有効な範囲(スコープ/エクステント)と，
どの型であるか？もしくは，どの型を持っているとして扱うか？のことだけが定義されいます。

' ByRef 引数
Private Sub TestByRefLong(ByRef lngValue As Long)
    lngValue = 100   ' 何が渡ってきても，100 にする。
End Sub

Private Sub Test2()

    Dim lngValue As Long
    lngValue = 1
    TestByRefLong lngValue + 1    '<--- 演算結果(a value)を渡す

End Sub

Private Sub TestByRefLong(ByRef lngValue As Long)
    lngValue = 100   ' 何が渡ってきても，100 にする。
End Sub

Private Sub TestByRefLong(ByVal lngValue As Long)
    lngValue = 100   ' 何が渡ってきても，100 にする。
End Sub

# さらに補足
 
 
何事にも例外はあって，
ByRef Variant 型 の引数をとる VBA の関数については，
もうひとつ知っておかないといけないことがあります。
 
 
これは，経験則でわかっている人も多いと思いますが，
関数呼び出しだと思っているものが，実は関数呼び出しでないものがあります。
例えば，
 
　Len や CLng
 
などは，VBA の関数呼び出しではなく，関数呼び出しにするには，
 
　VBA.Len や VBA.CLng
 
とする必要があります。
 
仕様書では，p.45 に
予約名 や special-form として，予約識別子 として定義されているものがあります。
 

MS-VBAL さんの引用:
reserved-name = “Abs” / “CBool” / “CByte” / “CCur” / “CDate” / “CDbl” / “CDec” / “CInt” / “CLng” / “CLngLng” / “CLngPtr” / “CSng” / “CStr” / “CVar” / “CVErr” / “Date” / “Debug” / “DoEvents” / “Fix” / “Int” / “Len” / “LenB” / “Me” / “PSet“ / “Scale“ / “Sgn” / “String”

MS-VBAL さんの引用:
special-form = “Array“ / “Circle” / “Input” / “InputB” / “LBound” / “Scale” / “UBound”

MS-VBAL さんの引用:
A <reserved-name> is a <reserved-identifier> that is used within expressions as if it was a normal program defined entity(2.2). A <special-form> is a <reserved-identifier> that is used in an expression as if it was a program defined procedure name but which has special syntactic rules for its argument.

訂正
 
上の方の Test6 ですが，
Dim vntValue As Long は，いらないので，
 

Private Sub Test6()

    Dim myClass As Class1
    Dim lngValue As Long

    Set myClass = New Class1

    lngValue = 1
    myClass.PropertyLongByRef = lngValue
    MsgBox lngValue                           ' 1 のまま

    lngValue = 1
    myClass.MethodLongByRef lngValue
    MsgBox lngValue                           ' 100 になっている

    lngValue = 1
    myClass.PropertyVariantByRef = lngValue
    MsgBox lngValue                           ' 1 のまま

    lngValue = 1
    myClass.MethodVariantByRef lngValue
    MsgBox lngValue                           ' 100 になっている

End Sub

ByRef Variant のまとめ
 
関数の ByRef 引数 と 予約名 について見てきたところで，
Len 関数 の動作の違いを見ることで，結びとします。
 
Len 関数は，文字数 もしくは 変数に必要な バイト数 を返します。
但し，Variant型 は，文字列に型強制(coercion)したときの 文字数 を返します。
 
Long型 の変数を直接 Len と VBA.Len 関数に渡してみます。

Dim lngValue As Long

lngValue = 1234567890
MsgBox Len(lngValue)             '(1)
MsgBox VBA.Len(lngValue)         '(2)

Dim strValue As String
strValue = "ABC"
MsgBox strVAlue

Dim vntValue As Variant
vntValue = "ABC"
MsgBox vntVAlue

Dim strValue As String
strValue = "ABC"
MsgBox strValue

Dim vntValue As Variant
vntValue = "ABC"
MsgBox vntValue

Private Declare Function QueryPerformanceCounter Lib "Kernel32" _
                        (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" _
                        (lpFrequency As Currency) As Long

'' String型変数 => ByRef Variant
Private Sub TestString()

    Dim ctr1 As Currency
    Dim ctr2 As Currency
    Dim freq As Currency
    
    Dim i As Long
    Dim m As Long
    Const IterationCount As Long = 100000
    
    Dim strValue As String
    strValue = "ABC"

    Debug.Print "String型変数を直接"
    
    For m = 1 To 10
        Call QueryPerformanceCounter(ctr1)

        For i = 1 To IterationCount
            Call VBA.CStr(strValue)       'String型 変数 直接
        Next

        Call QueryPerformanceCounter(ctr2)
        Call QueryPerformanceFrequency(freq)
        Debug.Print Format((ctr2 - ctr1) / freq, "0.00000000E-"" sec.""")
    Next
    
    MsgBox "終了"
    
End Sub

'' Variant型変数 => ByRef Variant
Private Sub TestVariant()

    Dim ctr1 As Currency
    Dim ctr2 As Currency
    Dim freq As Currency
    
    Dim i As Long
    Dim m As Long
    Const IterationCount As Long = 100000
    
    Dim vntValue As Variant
    vntValue = "ABC"

    Debug.Print "Variant型変数を直接"
    
    For m = 1 To 10
        Call QueryPerformanceCounter(ctr1)

        For i = 1 To IterationCount
            Call VBA.CStr(vntValue)       'Variant型 変数 直接
        Next

        Call QueryPerformanceCounter(ctr2)
        Call QueryPerformanceFrequency(freq)
        Debug.Print Format((ctr2 - ctr1) / freq, "0.00000000E-"" sec.""")
    Next
    
    MsgBox "終了"
    
End Sub

Dim strValue As String
strValue = "ABC"
MsgBox strValue & "DEF"

Dim vntValue As Variant
vntValue = "ABC"
MsgBox vntValue & "DEF"

Dim lngValue As Long
lngValue = 1234567890
MsgBox Hex$(lngValue)

Dim lngValue As Long
lngValue = 1234567890
MsgBox Hex(lngValue)

自分も Enum について少し調べてみました。
 
 
MIDL の enum の仕様
http://msdn.microsoft.com/en-us/library/windows/desktop/aa366818%28v=VS.85%29.aspx
 

MIDL さんの引用:
Objects of type enum are int types, and their size is system-dependent. By default, objects of enum types are treated as 16-bit objects of type unsigned short when transmitted over a network. Values outside the range 0 - 32,767 cause the run-time exception RPC_X_ENUM_VALUE_OUT_OF_RANGE.

VBAL さんの引用:
There is no Enum-specific value type. Instead, Enum members are represented as Long data values.

[entry("(null)"), helpcontext(0x000f6552)]
VbMsgBoxResult _stdcall MsgBox(
                [in] VARIANT* Prompt, 
                [in, optional, defaultvalue(0)] VbMsgBoxStyle Buttons, 
                [in, optional] VARIANT* Title, 
                [in, optional] VARIANT* HelpFile, 
                [in, optional] VARIANT* Context);

typedef [uuid(ED822012-6D7F-11CF-B949-00AA004455EA), helpcontext(0x0010fdf8)]
enum {
    vbOK = 1,
    vbCancel = 2,
    vbAbort = 3,
    vbRetry = 4,
    vbIgnore = 5,
    vbYes = 6,
    vbNo = 7
} VbMsgBoxResult;

・Application.GetOpenFilenameメソッド

        [id(0x00000433), helpcontext(0x00020816)]
        HRESULT GetOpenFilename(
                        [in, optional] VARIANT FileFilter, 
                        [in, optional] VARIANT FilterIndex, 
                        [in, optional] VARIANT Title, 
                        [in, optional] VARIANT ButtonText, 
                        [in, optional] VARIANT MultiSelect, 
                        [in, lcid] long lcid, 
                        [out, retval] VARIANT* RHS);

訂正:
%Program Files% -> %ProgramFiles% or %ProgramFiles(x86)%
　
　

最後の引数が[out, retval]属性で定義されてるなら、VBAでは戻り値扱いになります。
# これで、納得されるかな。

yayadon さんの引用:
訂正:
%Program Files% -> %ProgramFiles% or %ProgramFiles(x86)%
　
　

kumatti さんの引用:
%ProgramFiles% or %ProgramFiles(x86)%
 
エクスプローラだと環境変数でも開けますけど、OLE/COM Object Viewerでは開けませんでした。

失礼しました。

%ProgramFiles%

---------------------------
OLE/COM Object Viewer
---------------------------
LoadTypeLib( C:\Program Files\Common Files\Microsoft Shared\VBA\VBA7\VBE7.DLL ) failed.
<No system message defined> STG_E_FILENOTFOUND ($80030002)
---------------------------
OK   
---------------------------

◆ 参照渡し: メソッドの戻り値([out, retval] 型* 引数)の場合
 
上で見てきたように，
参照渡しの場合，
型が同じ変数を ByRef引数 に直接渡せば，その変数の場所が渡り，
変数の中身/値ではなく，変数自体が渡ったような感じになりました。
 
しかし，参照渡しであっても，
[out, retval] 引数 による戻り値の場合の参照渡しは，
参照渡しの引数に対して，VBAユーザーが変数を直接渡したとしても，
VBA は，VBA自身が用意した一時変数の場所を使います。
その後に，ユーザーが用意した変数に，浅くコピーします。
 
 
◆ VBA 側が入れるカラクリ
具体的なメソッドの方がいいと思ったので，
引数が多くてややこしいですが，以下のような呼び出しの場合を見てみます。
cf. http://www.moug.net/tech/exvba/0060013.html
下記のコード
 

Dim myFile As Variant   'Variant 型に変更してあります。
myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")

'引数省略時用 ----- 実は引数は省略できないため
Public Const vtMissing As Variant = 初期化(VT_ERROR で値は DISP_E_PARAMNOTFOUND)
'ロケールとソート
Public Const LOCALE_USER_DEFAULT As Long = &H400&

----------------------------------------------------------------------------
Dim myFile As Variant
Dim myFileFilter As Variant  'or String

Dim hr As Long          '実際の戻り値 HRESULT を受ける変数
Dim tmpRtn As Variant   'VBA が用意した参照渡し戻り値用変数

myFileFilter = "CSVファイル(*.csv),*.csv"
hr  = Application.GetOpenFilename( _
                         myFileFilter, _
                         vtMissing, _
                         vtMissing, _
                         vtMissing, _
                         vtMissing, _
                         LOCALE_USER_DEFAULT, _
                         tmpRtn )  '<-- 戻り値の参照渡しの箇所

If hr がエラーを示すか？ Then  ' S_OK ( 0& ) と比較しているだけに見えるが...
    ' もろもろの処理
    ' ここでエラーを発生させる等。
End If

'成功時
myFile = tmpRtn    ' 実際の戻り値用変数に代入(浅いコピー※)

Microsoft Windows XP との支援技術の互換性をテストする
http://msdn.microsoft.com/ja-jp/library/cc421545.aspx
Microsoft Active Accessibility 2.0 Software Development Kit Tools
http://web.archive.org/web/20021015014220/http://msdn.microsoft.com/downloads/sample.asp?url=/msdn-files/027/001/785/msdncompositedoc.xml
DeclareDPIAware.manifest
http://msdn.microsoft.com/en-us/library/windows/desktop/ee872012%28v=vs.85%29.aspx
Mt.exe
http://msdn.microsoft.com/en-us/library/windows/desktop/aa375649%28v=vs.85%29.aspx

mt.exe -manifest DeclareDPIAware.manifest -outputresource:AccExplorer32.exe;1

EXCELのシートをAccessのテーブルの様に扱うには
http://www.moug.net/faq/viewtopic.php?t=61500
 
 
◆ Excelファイルのデータを処理しているのはどこか？
 
話の流れの中で，
Excelファイルのデータを処理しているのはどこか？が出てきています。
カラクリに興味がない人には，
ある意味どうでもいいことなのでこちらに書きます。
 
答えから先に書くと，JETエンジンでも，Excel でもなく
 
　Excelファイル用の ISAMドライバ
 
というものが担当しています。具体的には，
%WINDIR%\System32 フォルダ内にある
 
　msexcl40.dll
 
という DLL が担当しています。
ISAM (Indexed Sequential Access Method) というのは，
レコード処理の仕方の方法論のうちの一つです。
 
 
◆ msexcl40.dll を指定していないのに，Jetはなぜ居場所がわかるか？
 
Jet 4.0 エンジンは，
Extended Properties に設定された "Excel 8.0" について，
レジストリの
 
　HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\ISAM Formats
 
ハイブ下に
 
　Excel 8.0 サブキー
 
を見つけ，その
 
　Engine エントリ
 
で
 
　Excel
 
という値を得て，レジストリの
 
　HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines
 
ハイブ下に
 
　Excel サブキー
 
を見つけ，
 
　Win32 エントリ
 
で，Jet 4.0 OLEDB 向け Excel用 ISAM を提供する DLL の居場所
 
　C:\Windows\System32\msexcl40.dll
 
を突き止める感じになっていると思われます。
その結果，使用するDLLの名前と居場所がわかります。
 
(テキストファイルは，mstext40.dll です)
 
 
◆ 関係する DLL がロードされるタイミング
 
ちなみに，以下のようなコードがあって，初めて実行した時
 

Dim cn As ADODB.Connection                                                 '(0)
Set cn = New ADODB.Connection                                              '(1)
cn.Provider = "Microsoft.Jet.OLEDB.4.0"                                    '(2)
cn.Properties("Data Source").Value = "Excelファイルのパス"                 '(3)
cn.Properties("Extended Properties").Value = "Excel 8.0;HDR=YES;"          '(4)
cn.Open                                                                    '(5)
cn.Close                                                                   '(6)
Set cn = Nothing                                                           '(7)

simple さんの引用:

この場合、SortにSortfunctionをどうやって与えるか不明なので、
その場しのぎの方法で数字も文字列として大小比較することにしました。

ありがとうございます。参考になります。
マニュアルに載っていないExecuteStatementというものがあるんですね。
（evalと同じ動作でしょうか。）
以下で、確認しました。

Sub test()
    Dim sc As Object
    Set sc = CreateObject("ScriptControl")
    '「Set sc = CreateObject("MSScriptControl.ScriptControl")」でも OK 。
    sc.Language = "jscript"

    Dim objArray As Object
    Set objArray = sc.eval("a=new Array()")
    sc.ExecuteStatement "function Push(s){if(!isNaN(parseInt(s)))a.push(s)}"

    sc.Run "Push", "1"
    sc.Run "Push", "5"
    sc.Run "Push", "2"
    sc.Run "Push", "3"
    sc.ExecuteStatement "a.sort(function(x,y){return x-y})"
    'sc.eval "a.sort(function(x,y){return x-y})"

    Dim GetValues
    GetValues = CallByName(objArray, "toString", VbMethod)
    '「GetValues = objArray.toString()」でも OK 。
    '「GetValues = objArray.ToString()」だと NG 。
    Stop  '確かにソートされてます。
End Sub

simpleさん、コメントありがとうございました。
なかなか、難しい題材なのですね。

クリップボードへのコピーをトリガーにしたい
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=70753;id=excel
ビューアチェイン
http://wisdom.sakura.ne.jp/system/winapi/win32/win92.html
WM_DRAWCLIPBOARDで処理するのが正攻法でしょうけど、実際のコードを示せないので、ダンマリしてました。
 
# フックの負担を軽くするテクが要るので。

http://www.moug.net/faq/viewtopic.php?t=61597
よく考えたらWin32には(Internet Archive)
http://www.mvps.org/emorcillo/download/vb6/*
(tl_ole.zip)
がありますね。
> DLCTL_NO_SCRIPTS
mshtmdid.h
 
昨今はWebAPIが主流ですし、Firefoxのmozctl.dllなんてのもあるので
過去のものになりつつあるのかなと。

> Firefoxのmozctl.dll
GeckoエンジンでWebページを開く(Office)
http://www.ka-net.org/office/of44.html

閉じます。