[ツリー表示へ] [ワード検索] [Home]
タイトル ： Microsoft Formsでのクリップボード操作のバグ？ 投稿日 ： 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のバグでしょうか？ |
をクリックするとツリー全体を一括表示します） - Microsoft Formsでのクリップボード操作のバグ？ - 掃除屋又兵衛 10/02/10-01:21No.14459