[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『テキストファイル保存で文字化けが起きる』(原人ザボーガー)
こんばんは、よろしくお願いいたします。
↓のカシスソーダさんのコードをお借りして使わせていただいております。 開いているテキストファイル(メモ帳)の内容を取得してテキストファイルとして 保存するものです。
[[20111214000005]] 『メモ帳内容取得で文字数制限を外す』(カシスソーダ)
コードはほとんどそのままで今回一部改変しました。 開いているメモ帳の内容に環境依存文字が含まれている場合は出来上がる テキストファイル内容が環境依存文字の部分が文字化けしてしまいます。 テキストファイル作成(Function txtsakusei)の部分を書き換えてみましたが 文字化けは改善しませんでした。
メモ帳を手動でunicode形式で保存した場合は文字化けは起こりませんでした。 環境依存文字の種類によっては文字化けしますが、手動でも文字化けする文字 については目をつぶっております。
手動で保存したら文字化けしない文字についてはマクロで自動保存しても文字 化けしないようにするにはどのようにすればいいでしょうか? ご教示頂きますようお願いいたします。
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _ (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _ (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _ (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const WM_GETTEXT As Long = &HD Const WM_GETTEXTLENGTH As Long = &HE Const WM_DESTROY As Long = &H2
Sub test() Dim genzai As String Dim hWnd As Long, hWndEdit As Long Dim lngRet As Long Dim Title As String Dim TitleLen As Long Dim sts As Boolean Dim Ans As Long Dim myText As String Dim MyLen As Long Dim tmp As String Dim newtxtstr As String Dim txtmei As String Dim fol As String Dim cnt As Integer '現在時刻 genzai = Format(Now, "yy年mm月dd日hh時mm分ss秒") 'フォルダ名 fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") _ & "\" & Format(Now, "yymmdd_hhmmss") cnt = 0 hWnd = FindWindowEx(0, 0, "Notepad", vbNullString) If hWnd = 0 Then MsgBox "メモ帳が見つかりません。" Exit Sub End If Do While hWnd <> 0 cnt = cnt + 1 'フォルダ作成 If cnt = 1 Then MkDir (fol) 'タイトル取得 TitleLen = GetWindowTextLength(hWnd) Title = String(TitleLen + 1, 0) sts = GetWindowText(hWnd, Title, TitleLen + 1) txtmei = Title txtmei = Left(txtmei, InStr(txtmei, vbNullChar) - 1) If Right(txtmei, 10) = ".txt - メモ帳" Then txtmei = Left(txtmei, Len(txtmei) - 10) ElseIf txtmei = "無題 - メモ帳" Then txtmei = "無題" End If 'タイトルをテキストファイル名に改変 txtmei = genzai & "_" & Format(cnt, "000") & "(" & txtmei & ")" & ".txt" hWndEdit = FindWindowEx(hWnd, 0, "Edit", "") MyLen = SendMessage(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) myText = String(MyLen + 1, vbNullChar) lngRet = SendMessage(hWndEdit, WM_GETTEXT, Len(myText), ByVal myText) tmp = Left$(myText, InStr(1, myText, vbNullChar) - 1) newtxtstr = tmp & vbCrLf & genzai '新規テキストファイル出力 Call txtsakusei(newtxtstr, fol & "\" & txtmei, "unicode") '変えてあります Ans = SendMessage(hWnd, WM_DESTROY, 0&, 0&) hWnd = FindWindowEx(0, hWnd, "NotePad", vbNullString) Loop End Sub
'変えてあります Function txtsakusei(ByVal txtstr As String, txtpath As String, cset As String) Dim strm As New ADODB.Stream '★ With strm .Charset = cset 'Streamオブジェクトを開く .Open .writeText (txtstr) .saveToFile txtpath, 2 'Streamオブジェクトを閉じる .Close Set strm = Nothing End With End Function
’付加 Function CharSetOfText(Path) Dim FSO As Object Dim objFile As Object Dim htmlfile As Object Set FSO = CreateObject("Scripting.FileSystemObject") Set objFile = FSO.GetFile(Path) Set htmlfile = GetObject(objFile.Path, "htmlfile") Do While htmlfile.readyState <> "complete" Sleep 100 DoEvents Loop CharSetOfText = htmlfile.Charset Set objFile = Nothing Set FSO = Nothing End Function
< 使用 Excel:Excel2007、使用 OS:WindowsVista >
https://msdn.microsoft.com/ja-jp/library/Cc364313.aspx
に有る通り、渡せる文字でないものは文字化けするのは仕方ないのでは?
後は、ADODB.Stream を使わない方法に変更するかです。
(ウッシ) 2015/09/03(木) 08:24
ウッシさん、ご回答ありがとうございます。
リンク元の
Function txtsakusei(ByVal txtstr As String, txtpath As String) Dim fnum As Integer fnum = FreeFile Open txtpath For Output As fnum Print #fnum, txtstr; Close fnum End Function
のままだったら文字化けしたので今回変えて試してみました。 (原人ザボーガー) 2015/09/03(木) 08:36
> tmp = Left$(myText, InStr(1, myText, vbNullChar) - 1) > newtxtstr = tmp & vbCrLf & genzai
↓のように変えてみました。 テキストファイルに書き込む内容を一旦セルに書き出してみました。 セルに転記された文字列は文字化けしてました。 メモ帳内容取得段階で既に文字化けしているようです。
tmp = Left$(myText, InStr(1, myText, vbNullChar) - 1) ActiveCell.Value = tmp DoEvents Sleep 2000 newtxtstr = tmp & vbCrLf & genzai (原人ザボーガー) 2015/09/03(木) 08:53
lngRet = SendMessage(hWndEdit, WM_GETTEXT, Len(myText), ByVal myText)
のSendMessageの段階で文字化けしてますね。
APIのSendMessageの問題なので、別の方法でメモ帳のデータを取得するか、
開いてるメモ帳を名前を付けて保存する方向に変更した方がいいかも・・・
(ウッシ) 2015/09/03(木) 09:24
ウッシさん、ご回答ありがとうございます。
>APIのSendMessageの問題なので、別の方法でメモ帳のデータを取得するか、 >開いてるメモ帳を名前を付けて保存する方向に変更した方がいいかも・・・
その方向で進めてみます。 ありがとうございました。 (原人ザボーガー) 2015/09/03(木) 09:41
ANSI対応のものを呼んでいるからUnicodeは拾えない道理なので Unicode対応のものを呼んでみようじゃないかという話で 元の記述をそのまま拾い上げつつとりあえず動いたコードぺたり Option Explicit Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SendMessageUni Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageUniStr Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const WM_GETTEXT As Long = &HD Const WM_GETTEXTLENGTH As Long = &HE Const WM_DESTROY As Long = &H2 Sub test() Dim genzai As String Dim hWnd As Long Dim hWndEdit As Long Dim lngRet As Long Dim Title As String Dim TitleLen As Long Dim sts As Boolean Dim Ans As Long Dim myText As String Dim MyLen As Long Dim tmp As String Dim newtxtstr As String Dim txtmei As String Dim fol As String Dim cnt As Integer Dim byt() As Byte Dim bytfooter() As Byte Dim fnum As Integer '現在時刻 genzai = Format(Now, "yy年mm月dd日hh時mm分ss秒") bytfooter = vbCrLf & genzai 'フッタとして書き込むByte配列をセット 'フォルダ名 fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "yymmdd_hhmmss") cnt = 0 hWnd = FindWindowEx(0, 0, "Notepad", vbNullString) If hWnd = 0 Then MsgBox "メモ帳が見つかりません。" Exit Sub End If Do While hWnd <> 0 cnt = cnt + 1 'フォルダ作成 If cnt = 1 Then MkDir (fol) 'タイトル取得 TitleLen = GetWindowTextLength(hWnd) Title = String(TitleLen + 1, 0) sts = GetWindowText(hWnd, Title, TitleLen) txtmei = Title txtmei = Left(txtmei, InStr(txtmei, vbNullChar) - 1) If Right(txtmei, 10) = ".txt - メモ帳" Then txtmei = Left(txtmei, Len(txtmei) - 10) ElseIf txtmei = "無題 - メモ帳" Then txtmei = "無題" End If 'タイトルをテキストファイル名に改変 txtmei = genzai & "_" & Format(cnt, "000") & "(" & txtmei & ")" & ".txt" hWndEdit = FindWindowEx(hWnd, 0, "Edit", "") MyLen = SendMessageUni(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) '文字数が取得される様子 ReDim byt(0 To MyLen * 2 - 1) '1文字2Byte前提で領域確保 'byt = String(MyLen, vbNullChar) 'NULL文字で初期化と考えても良いか lngRet = SendMessageUniStr(hWndEdit, WM_GETTEXT, UBound(byt) + 1, VarPtr(byt(0))) '新規テキストファイル出力 fnum = FreeFile Open fol & "\" & txtmei For Binary As #fnum Put #fnum, , &HFEFF 'BOM Put #fnum, , byt Put #fnum, , bytfooter Close #fnum Ans = SendMessage(hWnd, WM_DESTROY, 0&, 0&) hWnd = FindWindowEx(0, hWnd, "NotePad", vbNullString) Loop End Sub (ご近所PG) 2015/09/03(木) 12:22
ご近所PGさん、ご回答ありがとうございます。
バイナリーモードというのを初めて見ました。 というか、今まで見ていたとは思うのですが、頭に入っていなかったのだ と思います。まだ少しだけしか調べてませんが、使いこなしたら便利に なると思います。 勉強してみます。ありがとうございました。 (原人ザボーガー) 2015/09/03(木) 13:40
SendMessageWってあったんですね。
(ウッシ) 2015/09/03(木) 14:13
テキストファイル出力部分のみ目が行ってましたが、
Private Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SendMessageUni Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageUniStr Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
の部分が付加されていたんですね。勉強します。 (原人ザボーガー) 2015/09/03(木) 15:22
主眼はソコです。 ここら辺を見てみてください。 文字列を使用する https://msdn.microsoft.com/ja-jp/library/windows/desktop/ff381407%28v=vs.85%29.aspx この真ん中らへんくらい
Unicode 関数と ANSI 関数
マイクロソフトが Windows に Unicode のサポートを導入したときは、スムーズな移行を実現するために ANSI 文字列と Unicode 文字列のそれぞれに対応する 2 つの API を提供しました。たとえば、ウィンドウのタイトル バーのテキストを設定する関数には次の 2 つがあります。
SetWindowTextA: ANSI 文字列を使用します。
SetWindowTextW: Unicode 文字列を使用します。
みたいな。 あ、ちなみに「SendMessageStr」は自分で検証するために追加しただけで 実際にコードの中では使用してません。(デバッグで使っただけ) (ご近所PG) 2015/09/03(木) 16:06
別々のテキストファイルではなく一つのテキストファイルに保存、としてみました。 ありがとうございました。
Option Explicit Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SendMessageUni Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageUniStr Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const WM_GETTEXT As Long = &HD Const WM_GETTEXTLENGTH As Long = &HE Const WM_DESTROY As Long = &H2
Sub test() Dim genzai As String Dim hWnd As Long Dim hWndEdit As Long Dim lngRet As Long Dim Title As String Dim TitleLen As Long Dim sts As Boolean Dim Ans As Long Dim myText As String Dim MyLen As Long Dim tmp As String Dim newtxtstr As String Dim txtmei As String Dim fol As String Dim cnt As Integer Dim byt() As Byte Dim bytlf() As Byte Dim bytfooter() As Byte Dim fnum As Integer '現在時刻 genzai = Format(Now, "yy年mm月dd日hh時mm分ss秒") bytlf = vbCrLf & "----------" & vbCrLf 'ファイルとファイルの間に書き込む改行と区切りByte配列をセット bytfooter = genzai 'フッタとして書き込むByte配列をセット 'フォルダ名 fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") 'テキストファイルパス指定 txtmei = fol & "\" & genzai & ".txt" cnt = 0 hWnd = FindWindowEx(0, 0, "Notepad", vbNullString) If hWnd = 0 Then MsgBox "メモ帳が見つかりません。" Exit Sub End If Do While hWnd <> 0 cnt = cnt + 1 If cnt = 1 Then 'テキストファイルを開く fnum = FreeFile Open txtmei For Binary As #fnum Put #fnum, , &HFEFF 'BOM End If 'タイトル取得 'TitleLen = GetWindowTextLength(hWnd) 'Title = String(TitleLen + 1, 0) 'sts = GetWindowText(hWnd, Title, TitleLen) 'txtmei = Title 'txtmei = Left(txtmei, InStr(txtmei, vbNullChar) - 1) 'If Right(txtmei, 10) = ".txt - メモ帳" Then ' txtmei = Left(txtmei, Len(txtmei) - 10) 'ElseIf txtmei = "無題 - メモ帳" Then ' txtmei = "無題" 'End If hWndEdit = FindWindowEx(hWnd, 0, "Edit", "") MyLen = SendMessageUni(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) '文字数が取得される様子 ReDim byt(0 To MyLen * 2 - 1) '1文字2Byte前提で領域確保 'byt = String(MyLen, vbNullChar) 'NULL文字で初期化と考えても良いか lngRet = SendMessageUniStr(hWndEdit, WM_GETTEXT, UBound(byt) + 1, VarPtr(byt(0))) 'テキストファイル出力 Put #fnum, , byt '内容 Put #fnum, , bytlf '改行と区切り文字付加 Ans = SendMessage(hWnd, WM_DESTROY, 0&, 0&) hWnd = FindWindowEx(0, hWnd, "NotePad", vbNullString) Loop If cnt <> 0 Then 'テキストファイルを閉じる Put #fnum, , bytfooter Close #fnum End If End Sub (原人サボーガー) 2015/09/03(木) 19:00
少し処理を変えて、というか、発展させてみようと思います。 現在は、メモ帳の内容全体が取得対象になっていますが、今度は、メモ帳のウィンドウで マウスで選択した範囲のテキストを取得する、というのをやってみようと考えています。
調べたら、 EM_GETSEL というのが使えるかもしれない、ということが分かりました。
これを使うと、ウィンドウの中の選択範囲の開始と終わりが取得できるようです。
http://wisdom.sakura.ne.jp/system/winapi/win32/win67.html
>エディットコントロールの情報を得る場合もメッセージを使う >EM_GETSEL を送れば、現在選択されているテキストの位置を知ることができる >これは、WPARAM に開始位置を格納するための32ビット整数型変数へのポインタを >LPARAM には、終了位置を格納するための32ビット整数型変数へのポインタを指定します
>ただし、このメッセージは SendMessage() 関数の戻り値からも値を取得できます >下位ワードに選択範囲の開始位置、上位ワードに終了位置が格納されています >この方法で値を取得する時、変数で受け取る必要がない場合 >WPARAM と LPARAM のパラメータには NULL を指定することができます
コードの宣言部に Const EM_GETSEL As Long = &HB0 を付加、 >MyLen = SendMessageUni(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) '文字数が取得される様子 の部分に EM_GETSEL を組み込んでやればいいと思うのですが、組み込み方と、 >lngRet = SendMessageUniStr(hWndEdit, WM_GETTEXT, UBound(byt) + 1, VarPtr(byt(0))) をどのように変えたらいいかが分かりません。
ヒントや参考ページがありましたらご教示お願いいたします。 (原人サボーガー) 2015/09/04(金) 08:46
与えられた情報を見て考えるなら 例えばこんな感じとかで Option Explicit Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function SendMessageUni Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long Private Declare Function SendMessageUniStr Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Const WM_GETTEXT As Long = &HD Const WM_GETTEXTLENGTH As Long = &HE Const WM_DESTROY As Long = &H2 Const EM_GETSEL As Long = &HB0 Sub test() Dim genzai As String Dim hWnd As Long Dim hWndEdit As Long Dim lngRet As Long Dim MyLen As Long Dim txtmei As String Dim cnt As Integer Dim byt() As Byte Dim bytlf() As Byte Dim bytfooter() As Byte Dim fnum As Integer Dim i As Long Dim seltxtS As Long Dim seltxtE As Long genzai = Format(Now, "yy年mm月dd日hh時mm分ss秒") '現在時刻 bytlf = vbCrLf & "----------" & vbCrLf 'ファイルとファイルの間に書き込む改行と区切りByte配列をセット bytfooter = genzai 'フッタとして書き込むByte配列をセット 'ファイルパス指定 txtmei = CreateObject("WScript.Shell").SpecialFolders("Desktop") txtmei = txtmei & "\" & genzai & ".txt" cnt = 0 hWnd = FindWindowEx(0, 0, "Notepad", vbNullString) If hWnd = 0 Then MsgBox "メモ帳が見つかりません。" Exit Sub End If Do While hWnd <> 0 cnt = cnt + 1 If cnt = 1 Then 'テキストファイルを開く fnum = FreeFile Open txtmei For Binary As #fnum Put #fnum, , &HFEFF 'BOM End If hWndEdit = FindWindowEx(hWnd, 0, "Edit", "") '初期化 seltxtS = 0 seltxtE = 0 lngRet = SendMessageUni(hWndEdit, EM_GETSEL, VarPtr(seltxtS), VarPtr(seltxtE)) '範囲選択中の文字位置 '戻り値から分けるなら ' lngRet = SendMessageUni(hWndEdit, EM_GETSEL, 0&, 0&) '範囲選択中の文字位置 ' seltxtS = LW(lngRet) ' seltxtE = HW(lngRet) MyLen = SendMessageUni(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) '文字数が取得される様子 ReDim byt(0 To MyLen * 2 - 1) '1文字2Byte前提で領域確保 lngRet = SendMessageUniStr(hWndEdit, WM_GETTEXT, UBound(byt) + 1, VarPtr(byt(0))) 'ファイルへ出力 If seltxtE - seltxtS = 0 Then Put #fnum, , byt() '範囲選択されていない 全内容出力 Else '範囲選択部分のみ出力 1文字2Byte前提 For i = seltxtS * 2 To seltxtE * 2 - 1 Put #fnum, , byt(i) Next End If Put #fnum, , bytlf '改行と区切り文字付加 lngRet = SendMessage(hWnd, WM_DESTROY, 0&, 0&) hWnd = FindWindowEx(0, hWnd, "NotePad", vbNullString) Loop If cnt <> 0 Then 'テキストファイルを閉じる Put #fnum, , bytfooter Close #fnum End If End Sub Private Function LW(ByVal Value As Long) As Long LW = IIf((Value And &HFFFF&) > &H7FFF, (Value And &HFFFF&) - &H10000, Value And &HFFFF&) End Function Private Function HW(ByVal Value As Long) As Long HW = (Value And &HFFFF0000) \ &H10000 End Function
範囲選択された位置は位置で貰って、 テキスト取得は全部取得した上で その中のどこを書き出すのよ、という流れで。 直接範囲部分だけを拾えるのかとかはわかりません。 (これらAPIの操作自体、この質問にある情報から調べただけなので経験値が無いです) ちょっと関数名修正 13:38 (ご近所PG) 2015/09/04(金) 13:32
ご近所PGさん、ご回答ありがとうございます。
↓が大いに勉強になりました。ありがとうございます。 戻り値の取得方法がいまいちわかっておりませんでした。
' seltxtS = LW(lngRet) ' seltxtE = UW(lngRet)
ご教示いただきました記述で作動しましたが、複数メモ帳が開いている状態で 実行したら、選択内容が新規テキストファイルに反映されない場合がありました。
↓のようなテキストファイルが生成されます。
aaa ---------- bbb ----------
----------
---------- 15年09月04日19時07分26秒
lngRet = SendMessage(hWnd, WM_DESTROY, 0&, 0&)
をコメントアウトして続けて実行したら、反映されないメモ帳は同じものでした。
一旦すべてのメモ帳とブックを閉じ、再度メモ帳とブックを開いてマクロを実行しても 同様でした。
しばらく時間をおいて同じ複数のメモ帳を開いて実行すると、今度は先ほどとは別の メモ帳の選択内容が反映されない、ということも起こっています。
また、マクロを実行すると、エクセルが落ち、中途半端なテキストファイルが生成され ることもあります。
たとえば、4つのメモ帳を開いて実行したら2つのメモ帳の内容は反映されてるけど 他の2つのメモ帳の内容とフッターが反映されてない、という感じです。
エラーの回避方法がありましたらご教示お願いいたします。 お手数おかけしますがよろしくお願いいたします。 (原人ザボーガー) 2015/09/04(金) 19:15
もしかしたら、ですけど、文字列が取得できないファイルは、選択範囲が小さくても 元々のファイルのサイズが大きい場合のようです。 ファイルサイズが16KBより大きいと途端に文字列が取得できなくなるような感じです。 (原人ザボーガー) 2015/09/04(金) 22:52
パソコンの性能は詳しくないのですが、コントロールパネルで見たら、
プロセッサ:Genuin Intel(R) CPU @ 1.80GHz メモリ(RAM): 4.00GB システムの種類: 32ビットオペレーティングシステム
となってました。 (原人ザボーガー) 2015/09/05(土) 08:37
検証してはいないですが、 私の記述の中で以下の部分 lngRet = SendMessageUniStr(hWndEdit, WM_GETTEXT, UBound(byt) + 1, VarPtr(byt(0))) UBoundの戻り値を今まで気にしたことが無かったのですが、 どうもInteger型みたいなのでここが悪さしてるかもしれません。 (ご近所PG) 2015/09/05(土) 12:53
と思ったらLongと書かれてるのもあるなぁ…… ちょっと細かに見る時間がないのでその辺を疑ってみて、もし解決しないなら 先にウッシさんも書かれてた様に一度ファイルに保存してから開いて読み込んで みたいな流れを考えてみても良いかもしれません。 (ご近所PG) 2015/09/05(土) 12:57
環境違うながらちょっと試すとファイルサイズ64K以上だとうまくGETTEXTでbyt配列に戻ってこないみたい? GETTEXTLENGHTは値を返してくるから他に書き方があるかもしれないけど、はて。 あとLW,HWで範囲の位置を拾うのは32Kまでしか返せないので直接値を得る記述の方使ってだと正しく位置は拾えてる。 (ご近所PG) 2015/09/05(土) 13:39
ご近所PGさん、ご回答ありがとうございます。
>先にウッシさんも書かれてた様に一度ファイルに保存してから開いて読み込んで >みたいな流れを考えてみても良いかもしれません。
今回の質問を機にAPIを調べています。名前を付けて保存もAPIでメモ帳の子ウィンドウ を制御して名前を付けて保存のウィンドウを表示し、ファイル名と文字コードを設定、という 流れのようです。
↓のNo.3の方の回答が参考になりそうです。 http://oshiete.goo.ne.jp/qa/2329915.html
処理が違いますのでコマンドID等を調べ中です。 ただ、当方VBの環境がないので調べるのに時間がかかりそうです。こちらも ヒントがありましたらご教示お願いいたします。
過去ログを調べたら、のらじろうさんという方がやはりAPIを使った方法で似たような処理 を行っていました。
[[20150517100427]] 『メモ帳内容の全範囲を選択しクリップボード格納(A』(のらじろう)
こちらも勉強してみます。 (原人ザボーガー) 2015/09/06(日) 01:15
とりあえずしばらく時間が作れませんという宣言だけ。気にはなってるのですが。 どなたか興味関心ある方はご参加のほど…… といってもExcelの範疇から外れてるのでアレですが。 (ご近所PG) 2015/09/07(月) 14:07
ご近所PGさん、ご回答ありがとうございます。
気に掛けていただきありがとうございます。
調べながら気長にボチボチやってみます。 何かありましたら書き込みいただきましたら幸いです。
(原人ザボーガー) 2015/09/07(月) 21:21
いろいろ試してみましたが、エクセルが落ちたりするのを止められませんでした。 そこで既に開いているメモ帳の内容を取得するのは諦めて、ユーザーフォームに マルチページを配置し、マルチページに必要なだけページを追加し、ページの中に テキストボックスを配置し、テキストボックスにテキストファイルの内容を表示、という 方法に変えることにしました。 まだ作成途中ですが、あとは自力で出来そうです。 いろいろご教示いただきありがとうございました。
’マルチページにページとテキストボックスを追加 ’この中にテキストファイルの内容を取得して転記する処理を追加する Private Sub CommandButton1_Click() Dim ctrl As Object Dim pg As Object With Me.MultiPage1 Set pg = .Pages.Add With pg Set ctrl = .Controls.Add("Forms.TextBox.1") With ctrl .Top = 0 .Left = 0 .Height = Me.MultiPage1.Height - 20 .Width = Me.MultiPage1.Width - 10 .MultiLine = True .ScrollBars = fmScrollBarsBoth .Value = Now 'ここをテキストファイル内容取得に変更 End With End With End With End Sub
’マルチページの各ページのテキストボックスで選択している範囲の文字列を取得 Private Sub CommandButton2_Click() Dim i As Integer Dim cnt As Integer cnt = Me.MultiPage1.Pages.Count For i = 1 To cnt MsgBox Me.MultiPage1.Pages("Page" & i).Controls("textbox" & i).SelText Next i End Sub
’ユーザーフォーム起動時マルチページにテキストボックスを追加 Private Sub UserForm_Initialize() Dim ctrl As Object Dim pg As Object With Me.MultiPage1 Set pg = .Page1 With pg Set ctrl = .Controls.Add("Forms.TextBox.1") With ctrl .Top = 0 .Left = 0 .Height = Me.MultiPage1.Height - 20 .Width = Me.MultiPage1.Width - 10 .MultiLine = True .ScrollBars = fmScrollBarsBoth .Value = Now End With End With End With End Sub (原人ザボーガー) 2015/09/13(日) 21:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.