tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルMicrosoft Formsでのクリップボード操作のバグ?
記事No14459
投稿日: 2010/02/10(Wed) 01:21
投稿者掃除屋又兵衛
↓この過去ログに関係するかしないか……? なんですが。
http://hanatyan.sakura.ne.jp/yybbs/read.cgi?no=102
Microsoft Forms2.0のsettextの動きが変なのです。

最初にやろうとしてたのは、WinXP ProのExcel2003/2007の
セルの内容をVB6で作成されたアプリのテキストボックスに
クリップボード経由で貼り付けることでした。
ちなみにVB6のソースを直す方法もありだったんですけど、
自分の作ったアプリでなかったのでいじりたくなかったのです。

セルの内容の最後に改行が入るし、結合されていても余分な
文字が入るので、単純なcopyメソッドじゃ出来ない訳です。
それで試しにこんな感じに書いてみました。

Sub SetClipboardDataObject()
    Dim CB As DataObject
    Set CB = New DataObject
    With CB
        .Clear
        .SetText ActiveCell.Value
        .PutInClipboard
    End With
    Set CB = Nothing
End Sub
しかしVB6のアプリ側でCTRL+Vで貼り付けしても何も起こらないんですね。
他にもいくつか試してみたら、メモ帳や秀丸エディタには貼り付け
出来ましたが、TeraPadなどいくつかのソフトでもVB6同様、何も起こらなかったです。

で、いろいろ試してみました。
VB6で同じソースでテストをしようとしましたが、Microsoft Forms2.0は
既に指定されている、とか言われて参照設定出来ないんですね。
VB6のclipboardオブジェクトは正常に動いていたようでした。
ExcelのVBAでWin32APIでゴリゴリとクリップボード関数を呼び出して
テストしていたら、最終的にクリップボードビュアーみたいなことに
なってしまいましたが、すごい変な動きしているみたいなことに
気づいたんです。

試行錯誤とか入ってるので、無駄なところとか変なところがあると
思いますがご勘弁を(苦笑)


Option Explicit
Declare Function OpenClipboard Lib "user32.dll" _
        (ByVal hWndNewOwner As Long) As Long
Declare Function EnumClipboardFormats Lib "user32.dll" _
        (ByVal format As Long) As Long
Declare Function GetClipboardFormatName Lib "user32.dll" Alias "GetClipboardFormatNameA" _
        (ByVal format As Long, ByVal lpszFormatName As String, ByVal cchMaxCount As Long) As Long
Declare Function CloseClipboard Lib "user32.dll" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function CountClipboardFormats Lib "user32.dll" () As Long
Declare Function IsClipboardFormatAvailable Lib "user32.dll" _
        (ByVal format As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Const GMEM_MOVEABLE = &H2
Private Const GHND = &H42
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Enum CF
    CF_TEXT = 1
    CF_BITMAP = 2
    CF_METAFILEPICT = 3
    CF_SYLK = 4
    CF_DIF = 5
    CF_TIFF = 6
    CF_OEMTEXT = 7
    CF_DIB = 8
    CF_PALETTE = 9
    CF_PENDATA = 10
    CF_RIFF = 11
    CF_WAVE = 12
    CF_UNICODETEXT = 13
    CF_ENHMETAFILE = 14
    CF_OWNERDISPLAY = &H80
    CF_DSPTEXT = &H81
    CF_DSPBITMAP = &H82
    CF_DSPMETAFILEPICT = &H83
    CF_DSPENHMETAFILE = &H8E
    CF_PRIVATEFIRST = &H200
    CF_PRIVATELAST = &H2FF
    CF_GDIOBJFIRST = &H300
    CF_GDIOBJLAST = &H3FF
End Enum
Sub ListClipboard()
'クリップボードのデータ形式をリストアップ
    Dim ret As Long
    Dim buf As String, buf2 As String, wk As String
    Dim fc As Long, lc As Long
    Dim disp As String
    lc = 0
    ret = OpenClipboard(Application.Hwnd)
    'ret = OpenClipboard(ByVal 0&)
    If ret <> 0 Then
        disp = CountClipboardFormats() & Chr(10)
        fc = 0
        Do
            fc = EnumClipboardFormats(fc)
            If fc <> 0 Then
                buf2 = ""
                Select Case fc
                    Case 1: buf = "CF_TEXT"
                    Case 2: buf = "CF_BITMAP"
                    Case 3: buf = "CF_METAFILEPICT"
                    Case 4: buf = "CF_SYLK"
                    Case 5: buf = "CF_DIF"
                    Case 6: buf = "CF_TIFF"
                    Case 7: buf = "CF_OEMTEXT"
                    Case 8: buf = "CF_DIB"
                    Case 9: buf = "CF_PALETTE"
                    Case 10: buf = "CF_PENDATA"
                    Case 11: buf = "CF_RIFF"
                    Case 12: buf = "CF_WAVE"
                    Case 13: buf = "CF_UNICODETEXT"
                    Case 14: buf = "CF_ENHMETAFILE"
                    Case &H80: buf = "CF_OWNERDISPLAY"
                    Case &H81: buf = "CF_DSPTEXT"
                    Case &H82: buf = "CF_DSPBITMAP"
                    Case &H83: buf = "CF_DSPMETAFILEPICT"
                    Case &H8E: buf = "CF_DSPENHMETAFILE"
                    Case &H200: buf = "CF_PRIVATEFIRST"
                    Case &H2FF: buf = "CF_PRIVATELAST"
                    Case &H300: buf = "CF_GDIOBJFIRST"
                    Case &H3FF: buf = "CF_GDIOBJLAST"
                    Case Else
                    buf = String(255, vbNullChar)
                    ret = GetClipboardFormatName(fc, buf, 254&)
                    buf = Left(buf, ret)
                End Select
                lc = lc + 1
                disp = disp & lc & ":" & fc & ":" & buf & Chr(10)
            End If
            DoEvents
        Loop Until fc = 0
        ret = CloseClipboard()
    End If
    MsgBox (disp)
End Sub
Function GetcData(fc As Long) As Byte()
'クリップボードのデータを表示
    Dim hMem As Long
    Dim p As Long
    Dim data() As Byte
    Dim Size As Long
    If IsClipboardFormatAvailable(fc) = 0 Then Exit Function
    hMem = GetClipboardData(fc)        'メモリブロックのハンドルをもらう
    If hMem Then
        Size = GlobalSize(hMem)             'サイズ取得
        p = GlobalLock(hMem)                'ポインタに変換
        ReDim data(0 To Size)               'バッファ用意
        MoveMemory VarPtr(data(0)), p, Size 'クリップボードからコピー
        GlobalUnlock hMem                   'ロック解除
    End If
    GetcData = data
End Function

これでSetClipboardDataObjectした後にListClipboardすると、
CF_UNICODETEXTだけでなく、CF_TEXTにもデータが入ってると
表示されます。
でも実際にGetcDataするとCF_UNICODETEXTではきちんと取り出せますが、
CF_TEXTではhMem = GetClipboardData(fc)のところで0が返ってきて
しまいます。
これを例えばExcelのセル内編集の状態で編集バー内でコピーするとか、
エクスプローラのアドレスバー内でコピーするとかすると、
CF_UNICODETEXTしかリストアップされません。
それでもCF_TEXTで要求すれば取り出せます。これはクリップボードの
仕様でANSIに自動変換されて取り出しが出来ているのですよね。
VB6のテキストボックスとかTeraPadはGetClipboardFormatNameで
CF_TEXTを調べて、あるよって言われるんで取り出そうとして、
取り出せなくて、結局何も起こらないのではないかと推測しています。

解決方法として、これでクリップボードに送りました。
Sub setcData(data() As Byte, wFormat As Long)
    Dim hMem As Long
    Dim Size As Long
    Dim p As Long 'メモリのポインタ
    
    If OpenClipboard(ByVal 0&) Then
        EmptyClipboard                          '空にする
        Size = UBound(data) + 1                 'データサイズ
        hMem = GlobalAlloc(GHND, Size) 'メモリブロック確保
        p = GlobalLock(hMem)                    'ポインタに変換
        MoveMemory p, VarPtr(data(0)), Size     'コピー
        GlobalUnlock hMem                       'ロック解除
        
        SetClipboardData wFormat, hMem          'クリップボードにコピー
        GlobalFree hMem                         'メモリブロック開放
    
        CloseClipboard                          'クリップボードを閉じる
    End If
End Sub

でも、一画面に配置された沢山のテキストボックスに、一度にデータを
送りたくなって、いちいちマクロを動かすのが面倒になったので、
最終的にはsendkeysにしてしまいましたけど……。

どうもすっきりしないです。これってMicrosoft Forms2.0のバグでしょうか?

[ツリー表示へ]
タイトルRe: Microsoft Formsでのクリップボード操作のバグ?
記事No14460
投稿日: 2010/02/10(Wed) 11:15
投稿者魔界の仮面弁士
> 最初にやろうとしてたのは、WinXP ProのExcel2003/2007の
> セルの内容をVB6で作成されたアプリのテキストボックスに
> クリップボード経由で貼り付けることでした。
念のため。
VB6 の TextBox は、日本語環境では Shift_JIS 専用であり、
Unicode には対応していません。

たとえば「立方メートル記号」などは、Excel 側には表示できても
VB6 の標準コントロールでは表示できない事に注意してください。


> Microsoft Forms2.0のsettextの動きが変なのです。
VB6 の VB.Clipboard の SetText メソッドではなく、
Forms 2.0 の MSForms.DataObject の SetText メソッドですね。

>         .SetText ActiveCell.Value
Forms 2.0 の MSForms.DataObject の SetText メソッドを用いていた場合、
CF_TEXT 形式のデータが正しく出力されないようです。
(そのせいか VBA のサンプルを見ると、クリップボード API を使った例が屡見られます)


たとえば "aaa,bbb,ccc" という文字列なら、本来であれば
 CF_TEXT:
  61,61,61,2C,
  62,62,62,2C,
  63,63,63(,00)
 CF_OEMTEXT:
  61,61,61,2C,
  62,62,62,2C,
  63,63,63(,00)
 CF_UNICODETEXT:
  61,00,61,00,61,00,2C,00,
  62,00,62,00,62,00,2C,00,
  63,00,63,00,63,00(,00,00)
というバイナリが出力されるべきかと思いますが、MSForms 経由だと
 CF_TEXT:
  61,61,61,2C,
  62,62,62,2C,
  63,63,63,00,
  00,00,00,00,
  00,00,00,00,
  00,00,00,00
 CF_OEMTEXT:
  61,61,61,2C,
  62,62,62,2C,
  63,63,63,00
 CF_UNICODETEXT:
  61,00,61,00,61,00,2C,00,
  62,00,62,00,62,00,2C,00,
  63,00,63,00,63,00,00,00
という結果で出力されてしまいます。

CF_OEMTEXT や CF_UNICODETEXT の内容は問題無さそうですが、
CF_TEXT の内容が明らかにおかしいです。

また、上記は "aaa,bbb,ccc" という文字列でしたが、ここに日本語が含まれた場合、
CF_TEXT 内のデータが文字化けしたり、そもそも格納されなかったりします。

手元の下記の環境において再現したところをみると、
どうも昔から、こういう仕様だったみたいですね。

 WinXP/SP3    + Excel 2007/SP2      + FM20.DLL (12.0.6514.5000)
 Win2000/SP無 + Excel 97/SR-1(8.0d) + FM20.DLL (2.1.3603.0)


> セルの内容の最後に改行が入るし
セルそのものを Ctrl + C でコピーした場合、「タブ区切りテキスト」形式で
取得されることになるからです。
(数式バーから Ctrl + C で文字列をコピーした場合には入らないと思います)

複数のセル範囲を Ctrl + C すると分かりますが、CF_TEXT/CF_OEMTEXT には
 ・エンコードは Shift_JIS で行われる(Unicode 文字は化ける)。
 ・列と列の間はタブ(0x09)で区切られる。
 ・行の末尾には改行(0x0D,0A)が挿入される。
 ・改行を含むセルの場合、両端が"(0x22)で囲まれる。
 ・テキストデータの末尾は 0x00 で終わる。
というデータ形式で格納されます。


> VB6で同じソースでテストをしようとしましたが、
VB6 の場合、VB.Clipboard オブジェクトを利用できるので、
通常は、MSForms.DataObject の出番は無いと思います。

ただし、Unicode テキストの転送を必要とする場合には、
 (案1) IE の clipboardData オブジェクトを利用する。
 (案2) クリップボード API を利用する。
といった対処が必要となるかと思います。


> Microsoft Forms2.0は既に指定されている、とか言われて参照設定出来ないんですね。
[プロジェクト]-[コンポーネント]で、『デザイナ』あるいは『コントロール』で
追加されたライブラリは、参照設定に加えられない可能性があります。

また、参照設定の一覧に表示されないライブラリの場合、vbp を直接操作しないと
設定を削除できない事があるようです。

なお、先のコードを参照設定せずに利用するなら、
 With GetObject("new:1C3B4210-F441-11CE-B9EA-00AA006B1A69")
  .Clear
  .SetText "TestData"
  .PutInClipboard
 End With
という構文が使えます。


> しかしVB6のアプリ側でCTRL+Vで貼り付けしても何も起こらないんですね。
先述したとおり、MSForms で 日本語文字を SetText した際に、
CF_TEXT が 0 バイトになってしまう(ことがある)ためです。

> 他にもいくつか試してみたら、メモ帳や秀丸エディタには貼り付け出来ましたが、
これらは、CF_TEXT ではなく、CF_UNICODETEXT を利用するためです。
CF_UNICODETEXT のデータについては、MSForms.DataObject でも問題ありません。

> どうもすっきりしないです。これってMicrosoft Forms2.0のバグでしょうか?
Microsoft に問い合わせた方がよさそうですね。

[ツリー表示へ]