Windows10環境にてExcel VBAのDataObjectを使用すると文字化けする

Question

概要

現在以下の環境にて、Excelセルのデータを他アプリケーションに貼り付ける処理を実装しています。

• Windows10 (64bit)
• MS Excel2016 (32bit)

処理としては、DataObjectを使用してセルデータをクリップボードにコピーし、
他アプリケーションに貼り付ける処理を実装しています。
また、「Microsoft Forms 2.0 Object Library」を使用しています。

知りたいこと
上記事象が発生する「原因」をご教示頂きたいです。

---

プログラム(抜粋)

Public Sub SampleCode

  ' 変数宣言  
  Dim dataObj as DataObject

  ' オブジェクト取得
  Set dataObj = new DataObject
  
  ' セルの値をクリップボードに設定
  With dataObj
    .SetText(Sheet1.Range("A1").Text)
    .PutInClipBoard
  End With
  
  ' 正しく値が取得できる
  Debug.Print dataObj.GetText
  
  ' 2秒待機
  Application.Wait Now() + TimeValue("00:00:02")
  
  ' **************************************************
  ' 正しく値が取得できない
  ' **************************************************
  Debug.Print dataObj.GetText
  
End Sub

---

補足情報として、当該事象は発生する端末と発生しない端末があります。
これらの端末間で、
「Microsoft Forms 2.0 Object Library」にて使用している「FM20.dll」ファイルの
差分はありませんでした。

また、本事象については、回避方法を検討済みです。
セルの値をクリップボートに設定する処理について、
DataObject を使用せず、「Sheet1.Range("A1").Copy」などで直接クリップボードに
コピーすると事象を回避できるようです。

冒頭にも述べた通り、本事象が発生する原因をご教示頂きたいです。

以上、なにとぞお助け頂けますと幸いです。

Comments

[atata0319]

手元にすぐに使える Office 2016 の環境がなかったので Office 2010 環境で試してみましたが再現しませんでした。OS は Windows10 Pro (64bit) になります。Office 2016 環境で試してみようとは思いますが、環境依存の問題であれば端末ごとの差を調べるしかなさそうな気がしますね。

[baseballyama]

atata0319さん

コメントありがとうございます。
Citrix環境にて、初期状態(配布されている資材のまま)で実行して結果差異がある状況です。
ただまずは本日Cドライブ配下で差分がある可能性が高いところからDiffしてみることにします。

[atata0319]

Office 2016 ではないですが、Office 365 ProPlus で再現しました。ステップ実行時とステップ実行なしで試したところ動作が異なります。ステップ実行では確実にクリップボードの内容が破壊されます。ステップ実行では時間をかけて実行すると初回のタイミングでもクリップボードの内容が破壊されます。非ステップ実行では比較的長い間（２～４秒）破壊されません。

上の実験結果を受けての推測ですが、Excel 自体のスレッドモデルの変更が影響していると推測しています。Excel のオートメーションモデルはかなりの時間をかけてマルチスレッドに対応してきています。現時点では VBE （VBA の実行環境）もマルチスレッド版を使用していると推測されます。

Excel の UI 上でコピー操作を実施すると Excel はクリップボードの遅延レンダリングを実施するために OleSetClipboard で Excel 内部の DataObject（IDataObject を実装したクラス） を設定していると考えられています。この DataObject はマルチスレッド（正確にはマルチアパートメント）に当然対応している（と思われる）ので、Excel マクロ自体でクリップボードを操作する場合、クリップボードの破壊は発生しません。一方、Forms 2.0 の DataObject はマルチスレッド（もしくはマルチアパートメント）に対応できておらず実行エンジンのアパートメントが切り替わるタイミングで破壊されてしまうのではないかと思います。

この推測を検証するためには自分で DataObject 相当のオブジェクトを作成して、実験してみることですが、手間がかかるので今はパスですね。そのうち実験してみて検証できたら回答に記載しておきます。

[baseballyama]

atata0319さん

詳細な仮説ありがとうございます。とても勉強になります。

1点気になるのは、なぜCitrix仮想環境(全員が同じ環境)で作業しているにも関わらず、
再現するユーザーと再現しないユーザーがいるのかということです。
何か見解などありませんでしょうか。

小職の技術不足によりお願いばかりとなっており大変恐縮なのですが、
お時間がありましたらご教示頂けると幸いです。

[atata0319]

Citrixを使用されているなら、クライアントクリップボードリダイレクトが有効になっているかどうかで変わりそうな気がします。各端末での設定を確認されてはどうでしょうか？
ただ、私のテスト環境はスタンドアロンなので、上記だけが影響しているとも考えられません。

参考にはなりませんが、影響があるかもしれない動作をつらつらと書いていきます。
・OneDriveと統合しているかどうか？OneDrive上のファイルを扱う場合、Excel側で同期処理が走るのでスレッドモデルが変更されそうな気がします。SharePoint上のファイルも同様ですね。こちらの o365 環境ならではというところですが。
・ActiveDirectory に統合している場合、クリップボードについてチェックが入り、それが影響している？ただ、クリップボードを使用する前に権限のチェックが入りそうな気がします。
・ターミナル環境でユーザー毎にリソースの割り当てが異なるためにCPUの割り当てがスイッチするユーザーとしないユーザーが存在している。ただ、先の仮説ではあくまでもソフトウェアレベルのスレッドの話なのでCPUのスイッチが影響するとは思えないですけどね。

Answer 1

はっきりとした原因はわかっていない状況ですが、Microsoft Developer Network にて issue を発見しました。

それによると、Microsoft は 2013年に問題を認識しているようですが、その後修正された旨の投稿はありません。
また、この問題に対して Microsoft は WindowsAPI を使用した処理に代替することを提案しています。

そこで、 VBA にて WindowsAPI を使用した処理に換装したところ、当該事象は発生しなくなりました。

メモリのロックやメモリアドレスなど、低レイヤーの実装を意識しなければならないため、
実装に際しては注意が必要ですが、
今回はこの方法で事象を回避しましたので共有致します。

ソースコードは以下。

Option Explicit

' WindowsAPI宣言
' 各APIの詳細は (http://wisdom.sakura.ne.jp/system/winapi/win32/win90.html) を参照のこと
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

' WindowsAPI゛て使用する定数宣言
Private Const GMEM_MOVEABLE As Long = &H2
Private Const GMEM_ZEROINIT As Long = &H40
Private Const CF_UNICODETEXT As Long = &HD


Public Sub Test()
    
    ' クリップボードにテキストを設定
    Call SetClipboard("テストテキスト")
    
    ' クリップボードのテキストを取得してイミディエイトウインドウに出力
    Debug.Print GetClipboard

End Sub

' 文字列をクリップボードにコピーします
' 本処理は DataObject を使用することで意図しない文字列がクリップボードに貼りつくことがあるため
' DataObject を使用せずに WindowsAPI を使用した処理で実装する
' また、処理中はメモリのロックを実施するため、本処理中で強制終了しないようにすること
Public Sub SetClipboard(ByRef sUniText As String)
    
    ' 変数宣言
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    
    ' クリップボードを開く (開けなかった場合はエラーをスロー)
    If OpenClipboard(0&) = 0 Then
        ' 実は開けていた場合に備えて閉じる処理を呼び出す
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "クリップボードを開けませんでした"
    End If
    
    ' クリップボードを空にする (失敗した場合はクリップボードを閉じてエラーをスロー)
    If EmptyClipboard = 0 Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "クリップボードを空にできませんでした"
    End If
    
    ' 確保するメモリ領域を取得 (終端文字ワイド文字列 分も確保するために2バイト多く確保)
    iLen = LenB(sUniText) + 2&
    
    ' ヒープから指定されたバイト数のメモリを確保 (失敗した場合はクリップボードを閉じてエラーをスロー)
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    If iStrPtr = Null Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "メモリの確保に失敗しました"
    End If
    
    ' グローバルメモリオブジェクトをロックし、メモリブロックの先頭へのポインタを取得
    iLock = GlobalLock(iStrPtr)
    If iLock = Null Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "メモリのロックに失敗しました"
    End If
    
    ' 指定された文字列を、メモリにコピー
    If lstrcpy(iLock, StrPtr(sUniText)) = Null Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "メモリのコピーに失敗しました"
    End If
    
    ' グローバルメモリオブジェクトのロックカウントを減らします
    ' 0以外が返却された場合はロックが解放されなかったとしてエラーをスローします
    If GlobalUnlock(iStrPtr) <> 0 Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "メモリのアンロックに失敗しました"
    End If
    
    ' クリップボードに、指定されたデータ形式でデータを格納
    If SetClipboardData(CF_UNICODETEXT, iStrPtr) = Null Then
        On Error Resume Next
        Call CloseClipboard
        On Error GoTo 0
        Err.Raise 1000, , "クリップボードにデータを格納できませんでした"
    End If
    
    ' クリップボードを閉じる
    If CloseClipboard = 0 Then
        Err.Raise 1000, , "クリップボードをクローズできませんでした"
    End If
    
End Sub

' クリップボードからテキストを取得します
' テキストを取得する処理においては DataObject を使用しても問題が発生しないことから
' WindowsAPI を使用しない実装とします
Public Function GetClipboard() As String
    
    With New DataObject
        .GetFromClipboard
        GetClipboard = .GetText
    End With
    
End Function

Answer 2

原因を特定できない場合、別の方法を試してみてはどうでしょうか。

VBAでセルに含まれる全ての数値をカウントアップするマクロを作成する - えくせるちゅんちゅん
にて「クリップボードへの格納に関しては従来のDataObjectを使った方法は安定しない…」ことが説明されており、以下サイトが紹介されていましたので参考にしてください。

[VBA]DataObjectを使ったクリップボード操作が上手くいかない場合の対処法

以下は、クリップボードへの格納を関数にした例です。

'Microsoft Forms 2.0 Object Libraryを参照設定
Sub CopyToClipboad2(ByVal strInput As String)
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .Text = strInput
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With
End Sub

Comments

[baseballyama]

ご回答ありがとうございます。自己解決のところに記載しますのが、Microsoftもこの問題を認識しており、WindowsAPIを使用する代替策を推奨しております。つきまして、対処法としてはMicrosoftの推奨方法にしようと考えています。
今回の質問背景として、原因を正しく把握して根本対策をしたかったというものがありましたが、現在のところはっきりとした根本原因はわかっていない状況です。

Answer 3

私は同じような経験をしています。
結論から、あきらめています。

この手のグラフィック関係は、
小生の結論から、パソコンのスペックに左右されると結論付けています。

パソコンのスペックによって、動いた入り動かなかったりしている現象を何度も見ています。

パソコンのスペックの違いで、動作検証はしましたか？
Excelの場合、グラフィックの処理スペックで結果が大きく異なります。

Excelの実体験では、パソコンのスペックで、動作結果が大きく異なるのが、グラフィック関係です。
運用を変えるか、マシンスペックを上げるかの２択ではと思います。

Comments

[baseballyama]

ご回答ありがとうございます。

小職のソースコードを見てわかる通り、DataObjectを使用してクリップボードへの設定を実施した直後は正しい値が取得できています。これはすなわち、一度は正しい値がメモリに格納されたことを意味しています。
その後、待機処理を実行したあとに同一メモリ領域から文字列を読みだそうとすると期待しない文字列が取得される (すなわちメモリが書き換えられている OR メモリを参照する位置が変わってしまっている)

また、クリップボードに少ない文字列情報を読み書きする処理は軽量な処理であることから、マシンスペックやブラフィックス性能はは関係ないと考えます。
加えて、コメントでも記載した通り、Citrix環境(同一スペックの環境)で複数人が同じ処理を実行して本事象が発生する場合と発生しない場合があることからも、マシンスペックの問題ではないと考えます。

本件については、コメント欄にて atata0319 さんが記載されている内容と小職の自己解決が参考になると考えています。

Answer 4

コピー直後と時間をおいた後でクリップボードの内容が違うということであれば、クリップボードを監視して書き換えるものがあるんじゃないでしょうか？

たとえば IDE とか、クリップボード履歴とか、アンチウィルスソフトとか。

もしかすると、SetText メソッド (フォーム) の format を 13 にすると改善するかもしれません。Standard Clipboard Formats

Comments

[baseballyama]

ご回答ありがとうございます。ご回答頂いた通り、クリップボードにコピーした直後は正しく読み出しができることから、何かの別プロセス、もしくはFM20.dll、もしくはそこから呼ばれるuser32.dllの内部で処理異常が発生していることによりメモリの上書きがされていると考えています。但し現在まで正しい原因はわかっていない状況です。
SetTextで13(UNICODE)を指定した処理も試しましたが、変化はありませんでした。