frog.raindrop.jp.knowledge > Visual Basic

November 1, 2010

VBA よりクリップボードにアクセスする

Excel VBA よりクリップボードに文字列を設定したくて、Microsoft Forms 2.0 Object Library のDataObject を使ってたんですけど、なぜか全くクリップボードが更新されず。先日の WSH 用の Tips を VBA に移植してみました。Excel 2003 SP3 + IE8 では動作してます。

Option Explicit

'' コマンドID
Private Enum OLECMDID
    OLECMDID_COPY = 12&
    OLECMDID_PASTE = 13&
    OLECMDID_SELECTALL = 17&
End Enum

'' IE のインスタンス
Private internetExplorer_ As Object

'' テキストエリア
Private textArea_ As Object

'' クリップボードに文字列をセットする
Public Sub SetText(text As String)
On Error GoTo ErrHandler:
    '' TEXTAREA に文字列をセット
    textArea_.innerText = text
    '' すべてを選択
    Call internetExplorer_.ExecWB(OLECMDID_SELECTALL, 0)
    '' コピー
    Call internetExplorer_.ExecWB(OLECMDID_COPY, 0)

    Exit Sub
ErrHandler:
    Call Err.Raise(Err.Number, "Clipboard.SetText()" & " ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub

'' クリップボードより文字列を取得する
Public Function GetText() As String
On Error GoTo ErrHandler:
    '' TEXTAREA の初期化
    textArea_.innerText = ""

    '' ペーストコマンド
    Call textArea_.ExecWB(OLECMDID_PASTE, 0)

    '' TEXTAREA の文字列を取得する
    GetText = textArea_.innerText

    Exit Function
ErrHandler:
    Call Err.Raise(Err.Number, "Clipboard.GetText()" & " ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function

'' クラス初期化処理
Private Sub Class_Initialize()
On Error GoTo ErrHandler:

    '' IE を起動する
    Set internetExplorer_ = CreateObject("InternetExplorer.Application")
    Call internetExplorer_.Navigate("about:blank")

    '' 安定するまで待つ
    Do While internetExplorer_.Busy
    Loop

    '' TEXTAREA 要素を作成する
    Set textArea_ = internetExplorer_.document.createElement("textarea")
    Call internetExplorer_.document.body.appendChild(textArea_)

    '' フォーカスを与えておく
    Call textArea_.Focus

ExitHandler:
    Exit Sub

ErrHandler:
    Call MsgBox(Err.Number & ":" & Err.Source & vbLf & Err.Description, vbCritical, "エラー")
    Resume ExitHandler

End Sub

'' クラス破棄時処理
Private Sub Class_Terminate()

On Error Resume Next

    ' IE が起動していれば終了させる
    If (Not internetExplorer_ Is Nothing) Then
        internetExplorer_.Quit
    End If

End Sub

December 18, 2005

Socket サンプル

VB で Winsock コントロールを使って、TCP あるいは UDP で通信するサンプルです。
確か、TCP と UDP のそれぞれで、ネットワークアドレスの競合が起こった時に、通信はどうなるかを検証するのに使ったんだったと思います。ていうか、そういうテストにしか使えません。VB6 用。
Download file

August 5, 2005

vbNullString 実験セット

vbNullString の話が思ったより反響あったので(リンクしていただいていたりするし)DLLとの文字列のやり取りあたりをちゃんと実験してみることにした。ライオン君からの受け売りじゃなんだしね。

結論

  • vbNullString ⇒ NULLポインタになる
  • vbNullChar ⇒ 長さ0の文字列になる
  • "" ⇒ 長さ0の文字列になる
  • String$(1, vbNullChar) ⇒ 長さ0の文字列になる

DLL に渡されるときは vbNullString と "" は区別されていることが分かる。あ、いかん、また混乱してきた。

実験に使ったモジュールとかソースとかほしい方は持ってってください。

vbNullString.lzh(23,927byte)

June 23, 2005

ファイル検索クラス

フォルダ内を再帰検索するときに Dir 関数ではちょっと面倒です。FindFirstFile, FindNextFile, FindClose をクラス化したものを古いソースより発見したのでこれも公開版に。

Property Attributes () As VbFileAttribute
最後に見つかったファイルの属性の組み合わせを返します
Property FileName () As String
最後に見つかったファイルのファイル名を返します
Function FirstFile (FileSpec As String) As Boolean
引数に一致する最初のファイルを検索します
Function NextFile () As Boolean
次のファイルを検索します
Sub Release ()
検索条件をリセットし、検索ハンドルを解放します
続きを読む...

June 20, 2005

汎用キュークラス

バリアント型の要素を格納するキューです。

以下のメンバを持ちます。

Property Count () As Long
格納されているデータの個数を返します
Property IsEmpty () As Boolean
キューが空なら True を返します
Property IsFull () As Boolean
キューがいっぱいなら True を返します
Sub Initialize ([ByVal MaxItem As Long = 255])
最大数をMaxItem個としてキューを初期化します
Function Peek () As Variant
先頭データを返します キューから削除しません
Function Pop () As Variant
先頭データを取り出します キューからは削除します
Sub Push (Item As Variant)
キューの最後尾にデータを追加します
続きを読む...

February 23, 2005

非同期イベント発生コントロール

時間のかかる処理をイベントと非同期に処理したいことがあり、ウインドウメッセージを使って非同期にイベントを発生させるユーザコントロールを作成しました。マルチスレッドではないので並列処理はできませんが、以外に使えるのでおいておきます。VB6用。

続きを読む...

ウインドウを一時的にアクティブにして最前面に持ってくる

後ろで動いてるアプリを手前に持ってくる関数です。いつも作るうえに、毎回調べないと作れないので載せておきます。

ちなみに、ウインドウが「常に」最前面に表示されるようにするには、SetWindowPos 関数で HWND_TOPMOST を渡します。でもこれはググればごろごろサンプル出てくるんですけどね。

続きを読む...

February 10, 2005

デスクトップの作業領域

私は今まで、VBでウインドウの配置を決めるのに、デスクトップのサイズを下のようにして得ていた。

Dim lngRet          As Long
Dim udtRcDesktop    As RECT

'' デスクトップ全体の矩形を取得します
lngRet = GetWindowRect( GetDesktopWindow(), udtRcDesktop )

でも、これだとタスクバーを含んじゃうんだよね。で、SystemParametersInfo関数を使うと、タスクバーを含まない、デスクトップの作業領域の矩形を得ることができます。

'' デスクトップの作業領域の矩形を取得します
lngRet = SystemParametersInfo( SPI_GETWORKAREA, 0&, udtRcDesktop, 0& )

続きを読む...

ListBox に水平スクロールバーを表示する

VB6のリストボックスは、項目が長くても横スクロールできない。横スクロールバーを出すには、LB_SETHORIZONTALEXTENT メッセージを送る必要がある。

項目追加するたびに横スクロールバーを調整するのはこんな感じ

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_GETHORIZONTALEXTENT    As Long = &H193
Private Const LB_SETHORIZONTALEXTENT    As Long = &H194&

'------------------------------------------------------------------
'プロシージャ名:  :AddItemAndSetScrollBar
'説明:            :リストボックスに項目を追加し、必要に応じて横スクロールバーを表示する
'引数:            :pListBox           I   リストボックス
'                 :pItem              I   追加する文字列
'                 :pIndex             I   追加位置
'------------------------------------------------------------------
Private Sub AddItemAndSetScrollBar(pListBox As VB.ListBox, pItem As String, Optional pIndex As Variant)
Dim sngTextWidth        As Single
Dim lngCurPixels        As Long
Dim lngNewPixels        As Long
    
    
    '' ここは説明は不要でしょう
    Call pListBox.AddItem(pItem, pIndex)
    
    '' 現在の幅を取得
    lngCurPixels = SendMessage(pListBox.hWnd, LB_GETHORIZONTALEXTENT, 0&, ByVal 0&)
    
    '' テキストの幅から必要なスクロール幅を計算
    '' 計算方法は適宜修正のこと
    '' リストボックスのフォントとフォームのフォントが同じならこんな感じで求められる
    With pListBox.Parent
        sngTextWidth = .TextWidth(pItem)                            '' 文字列の幅
        lngNewPixels = .ScaleX(sngTextWidth, .ScaleMode, vbPixels)  '' ピクセルに変換
    End With
    
    '' 余白分を足す
    '' ここでは適当に4ピクセル足してるが、システム標準の値とかあるのかしら
    '' GetSystemMetrics( SM_CXEDGE ) * 2 あたりがに合わしておくといいかも
    lngNewPixels = lngNewPixels + 4&
    
    '' 現在の幅がちっちゃければ設定します。
    If (lngNewPixels > lngCurPixels) Then
        Call SendMessage(pListBox.hWnd, LB_SETHORIZONTALEXTENT, lngNewPixels, ByVal 0&)
    End If
End Sub
続きを読む...

January 31, 2005

MakeSureDirectoryPathExists を VB6 でシミュレートする

VB6 で、MakeSureDirectoryPathExists 関数の動きをシミュレートしたものを作ったので、おいときます。

続きを読む...

January 20, 2005

VB6 実行時エラーのコールスタックを採取する小ネタ

VB6 で、エラーをハンドリングする際のスケルトン。例によって VB6 に限定しているのは、.NET はまだ仕事で使ってないので語るものを持たないためです。

エラーを必ずハンドリングする必要があるのは、呼出元を持たないプロシージャ、つまり、Sub Main() 、イベントプロシージャ、またはコールバックプロシージャ(ウインドウをサブクラス化した時のウインドウプロシージャとか、フックプロシージャのこと)などで、自分自身が大元の呼び出し元であるプロシージャ達です。それ以外のエラーは呼出元に返すことができます。

呼出元に返す際に、 Err オブジェクトにプロシージャ名をセットしていくと、前述の呼出元プロシージャでは、呼出順をとることができます。

続きを読む...

December 8, 2004

VB6 API ビューアの ENUMLOGFONTEX 構造体宣言の誤り

VB6 より Windows API を利用する場合に、APIビューアは便利ですが、しばしば宣言等に誤りがあります。

今回は、フォントファミリの列挙を行う EnumFontFamiliesEx 関数を使おうとして、ENUMLOGFONTEX 構造体の宣言をコピーしたのですが、

' API ビューアの宣言
Private Type ENUMLOGFONTEX
        elfLogFont As LOGFONT
        elfFullName(LF_FULLFACESIZE) As Byte
        elfStyle(LF_FACESIZE) As Byte
        elfScript(LF_FACESIZE) As Byte
End Type

のようになっていました。WinGDI.h には

// WinGDI.h (Microsoft Platform SDK February 2003) Line:1220
#if(WINVER >= 0x0400)
typedef struct tagENUMLOGFONTEXA
{
    LOGFONTA    elfLogFont;
    BYTE        elfFullName[LF_FULLFACESIZE];
    BYTE        elfStyle[LF_FACESIZE];
    BYTE        elfScript[LF_FACESIZE];
} ENUMLOGFONTEXA, FAR *LPENUMLOGFONTEXA;
typedef struct tagENUMLOGFONTEXW
{
    LOGFONTW    elfLogFont;
    WCHAR       elfFullName[LF_FULLFACESIZE];
    WCHAR       elfStyle[LF_FACESIZE];
    WCHAR       elfScript[LF_FACESIZE];
} ENUMLOGFONTEXW, FAR *LPENUMLOGFONTEXW;
#ifdef UNICODE
typedef ENUMLOGFONTEXW ENUMLOGFONTEX;
typedef LPENUMLOGFONTEXW LPENUMLOGFONTEX;
#else
typedef ENUMLOGFONTEXA ENUMLOGFONTEX;
typedef LPENUMLOGFONTEXA LPENUMLOGFONTEX;
#endif // UNICODE
#endif /* WINVER >= 0x0400 */

となっていますので、VB6 では、

' 正解
Private Type ENUMLOGFONTEX
        elfLogFont As LOGFONT
        elfFullName(LF_FULLFACESIZE - 1&) As Byte
        elfStyle(LF_FACESIZE - 1&) As Byte
        elfScript(LF_FACESIZE - 1&) As Byte
End Type

のようにするのが正しいです。

続きを読む...

June 30, 2004

Visual Studio Installer で、ActiveX EXE をインストールする

Visual Studio Installer で、ActiveX EXE を含むインストーラを作成して、実際にインストールしようとすると、

エラー1904 モジュール (ActiveX.Exeのプログラム名) の登録に失敗し
ました。HRESULT-2147024885 サポートへお問い合わせください。

というメッセージが表示される。継続を選択するとインストールは完了するが、ActiveX EXE がレジストリに登録されないままである。インストール時に登録するには、ちょっと設定をいじってやる必要がある。Google グループ: Visual Studio Installerについて が参考になる。以下引用。

  1. レジストリエディタでActiveX EXEのCLSIDを調べて、メモっておきます。
  2. プロジェクトエクスプローラの依存関係にActiveX EXEが含まれていることを確認します。(参照設定がされていれば、依存関係に追跡されると思います。)
  3. プロジェクトエクスプローラの依存関係にActiveX EXEをクリックしてプロパティの中のRegisterプロパティを0(vsifrNone)を選択します。
  4. プロジェクトエクスプローラから「関連付け」をダブルクリックして関連付けウィンドウを表示します。COMオブジェクトを選択して右ボタンクリックで「COMオブジェクトの追加」を選択します。このとき先にメモっておいたCLSIDを追加するCOMオブジェクトの名前として使います。
  5. 追加したCOMオブジェクトのプロパティの中のComponentプロパティにActiveXEXEを選択します。
  6. COMオブジェクトのプロパティの中のContextプロパティを2(vsiccLocalServer32)を選択します。

2004.08.05 追記
-----------------------
/RegServer オプションで登録したときと同じにするには、上記の手順でクラスの登録をするほかに、ActiveX EXE そのものをタイプライブラリ登録する必要がありそう。まだ調査中ですが。

June 17, 2004

vbNullString

vbNullString という組み込み定数がある。
コードエディタで記述して、Shift + F2 を叩いてみる。

Const vbNullString = ""
VBA.Constants のメンバ
0 の値を持つ文字列を要求する外部プロシージャを呼び出すときに使う定数です。

さらに MSDN をひいてみる

vbNullString 値 0 を持つ文字列
長さ 0 の文字列 ("") とは異なります。外部プロシージャを呼び出す場合に使用します。

えーと、つまり、NULL ポインタだと思ったらいい? LPCTSTR でいうところの、長さ 0 の文字列は、

LPCTSTR lpszZeroLengthString = "";

なのに対して、

LPCTSTR lpszNullString = NULL;

みたいなもんだと思っていい?、ってずっと理解してた。でもさ、

If vbNullString = "" Then
	Debug.Print "vbNullString = """""
Else
	Debug.Print "vbNullString != """""
End If

は、
vbNullString = ""
となるんだよね。しかも、String 型の初期値は vbNullString だっていう情報まで。

この疑問のヒントになりそうなのが、The Backyard - BSTR にある。

BSTRには、さらにルールがある。
  1. 空文字列はNULL
  2. 実体としてのBSTRはNULLエンドセンチネルを持つ
  3. 文字列内にL'\0'を保持できる
  4. BLOBとして利用しても良い(UTF-16とは限らない)

えーと、空文字列はNULL、これは "" と、NULL は区別しないルールになってるって理解でいいの? だれか詳しい人、教えてください。

May 14, 2004

Visual Studio Installer で作成した msi に含まれるファイルを知りたい

Visual Studio Installer で、たとえば、VB のプロジェクトより、依存ファイルを抽出すると、プロジェクトエクスプローラの ファイル>Project1 の出力>依存関係 以下に "MSVBVM60.MSM" など、拡張子が MSM のファイルが含まれることがあります。これは マージモジュール と呼ばれるもので、DLL や レジストリ情報など、依存モジュールをパッケージングしたものです。当然、実際インストールされる際には内容物が展開されることになるのですが、そのインストーラに含まれる DLL 等の一覧を得たいような場合があると思います。
※ というか、このあいだ、インストールした結果、システムが動かなくなってしまい、アンインストーラも起動しなくなってしまったため、置き換えられたDLLを手動で元に戻す必要があり、結局何が置き換えられたの?という事を調べなきゃいけなかったのです。

以下の方法で、依存ファイルを圧縮形式でなく、ばらばらのファイルとして展開された状態でインストーラを作成することができます。

  1. メニューのプロジェクト>プロジェクト名 のプロパティ を選択します。
  2. 「ビルド」タブを選択し、「パッケージファイル」を「圧縮しない」に変更します。
    # 標準は「セットアップ ファイルに圧縮」だと思います。
  3. ビルドします。

これで出力先に、ばらばらの状態で依存ファイルが格納されます。

April 15, 2004

NetServerGetInfo で ローカルコンピュータ名を取得する

仕事で、ローカルコンピュータ名を取得する必要がありそうなのですが、WinSock で取得しても面白くないので、今回は NetServerGetInfo で、VB 用の関数を作ってみました。ただし、Windows Me、98、95 等では関数定義が異なるため、使用できません。

続きを読む...

March 30, 2004

SHBrowseForFolder クラス

名づけて、VB 汎用モジュール アーカイブプロジェクト、第一弾です。いつまでもVB6使ってますが、有用なモジュールが結構たまっているのでちょっとづつ整理して行こうと思っています。

このモジュールは以下のようにしてフォルダ選択ダイアログを表示します。ちゃんと初期フォルダも選択されます。

Private Sub Command1_Click()
Dim objBrowse   As New CBrowseFolder

    objBrowse.Flags = BIF_NEWDIALOGSTYLE
    objBrowse.InitDir = CurDir()
    Set objBrowse.Owner = Me
    objBrowse.RootFolder = CSIDL_DESKTOP
    objBrowse.Title = "あなたの一番大事なフォルダを選択してください"
    Call MsgBox(objBrowse.Show())
    
End Sub
続きを読む...

March 2, 2004

rhs, lhs

lhsとrhs、という識別子にぶつかることがある。たとえばVBならCFooというクラスを定義する。メンバはプロパティがひとつ。グローバル変数である。

'// CFoo.cls
Option Explicit

Public Foo  As String

それから、CBarというクラスを定義する。CFooをインターフェースとしてインプリメントする。オブジェクトドロップダウンリストからCFooを選択すると、実装すべきインターフェースのスケルトンが作成される。

'// CBar.cls
Option Explicit
Implements CFoo

Private Property Let CFoo_Foo(ByVal RHS As String)

End Property

Private Property Get CFoo_Foo() As String

End Property

ほらでてきた。Property Let CFoo_Fooの引数に注目。これはright-hand side、すなわち「右辺値」を意味する慣例的な識別子であるらしい。

続きを読む...

February 8, 2004

タスクトレイにアイコンを表示するユーザーコントロール

2年くらいあっためてたレシピ。フォームにはっつけてIconプロパティに適当なアイコンを設定して、InTrayプロパティをTrueに設定すると、タスクトレイにアイコンが常駐します。アイコンがクリックされたりするとイベントが発生します。あと、コンテキストメニューも、FormなんかのPopUpMenuメソッドと同じ方法で表示することができます。ただし、自分で使う用に作ってあるので、無駄も多いしあんまり細かいところまでちゃんとできてません。バグもあるかもです。

これ作ったとき、VBでUserControlのPopupMenuメソッドでメニューを表示すると、キーボードでメニュー操作ができないのは何でかなー、フォーカスがはずれてもコンテキストメニューが出たままになってしまうなー、と問題を残したまま長く使っていたんだけど、このたび解決方法[homepage2.nifty.com]を見つけたので公開してみました。ポイントは

    Call SetForegroundWindow(UserControl.hwnd)
    Call UserControl.PopupMenu(Menu, flags, x, y, DefaultMenu)
    Call PostMessage(UserControl.hwnd, WM_NULL, 0&, 0&)

てな感じにSetForegroundWindowしてからメニューを表示しWM_NULLをポストすることらしいです。

---------------
2004/04/23 追記
GetSystemMetrics の引数を、間違って HEX で宣言していました。修正しました。
# うわーん、かっこわるー (-_-;)

続きを読む...

November 27, 2003

ADOでOracleのバインド変数つきPL/SQLを実行する

プロバイダがOraOLEDB.Oracle.1なら可能みたい。
MSDAORA.1ではできなかった。