Windows10 64bit excel2016で以下のマクロを実行すると
実行時エラー '-2147221040(800401d0)': DataObject:PutInClipboard OpenClipboardに失敗しました
とエラーが出てしまいます
デバックしてみると
.PutInClipboard 'クリップボードに格納
上記の部分が悪いようなのですがどのように修正すればいいのでしょうか?
Sub test() Dim sht As Worksheet 'Set sht = Sheets("test1") 'シート名は任意に指定 Set sht = ActiveSheet 'アクティブシートでマクロ実行する場合はこちらでも可 Dim aryPtn As Variant Dim ptn As Variant aryPtn = Array("、", "。", "★", "」", "」", ")", "\)", "\!", "\?", "!", "?", "・+") Dim strOutput As String '結果出力用 Dim strLine As String '1行に出力する文字列 Dim strRest As String '未処理の文字列 'セル(G23)から文字列を取得 strRest = sht.Range("G23").Value Dim iLen As Integer iLen = -1 'ループ処理 Do '先頭31文字を切り出す strLine = Left(strRest, 31) '文字長の初期化 iLen = -1 '置換パターンの数だけループ処理 For Each ptn In aryPtn '最後にマッチした区切り文字までの文字長を調べる Dim iLenWk As Integer iLenWk = FindEx(strLine, ptn) If iLenWk > iLen Then '長い文字長を採用していく iLen = iLenWk End If Next If iLen > 0 Then '区切り文字が見つかった場合、文字列を切り出す strLine = Left(strLine, iLen) End If '切り出した文字列を出力 strOutput = strOutput & strLine '切り出した文字列分を未出力文字列から除去 strRest = Mid(strRest, Len(strLine) + 1) If strRest = "" Then '未出力文字列がなくなったら終了 Exit Do End If '次の行を作る前に改行を追記 strOutput = strOutput & vbLf & vbLf Loop ''結果をP10セルに出力 sht.Range("P10") = strOutput '結果をクリップボードに出力 Dim objClip As New DataObject With objClip .SetText strOutput 'クリップボードにセットする値を指定 .PutInClipboard 'クリップボードに格納 End With End Sub '正規表現検索(最終マッチ文字までの文字長を返す) Function FindEx(ByVal vsTarget As String, ByVal vsPattern As String) As Integer Dim iIdx As Integer Dim objReg As Object Dim objMatchs Set objReg = CreateObject("VBScript.RegExp") With objReg .pattern = vsPattern .IgnoreCase = True .Global = True '正規表現検索 Set objMatchs = .Execute(vsTarget) If objMatchs.Count = 0 Then 'マッチしなかった場合-1 FindEx = -1 Else 'マッチ数を取得 iIdx = objMatchs.Count - 1 'マッチした候補の最終文字列までの文字長を返す FindEx = objMatchs(iIdx).FirstIndex + objMatchs(iIdx).Length End If End With Set objReg = Nothing End Function
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/07/11 04:01