• ベストアンサー

ソフト改行文字が入らず困っています

 VB6環境で、テキストボックスにEM_FMTLINES(= &HC8)をSendMessageしソフト改行文字を入れた形でテキストを取得したいのですが、希に複数行入力されているにもかかわらず、ソフト改行文字が追加されない場合があります。  MultiLineをtrueにしたテキストボックス「text1」とボタン「Command1」をフォームに貼り付け、以下のようなテストプログラムを作成してみました。(お見苦しいところありましたらすみません) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const EM_FMTLINES = &HC8 'ソフト改行文字を設定/削除する定数 Private Sub Command1_Click() Dim ret As Boolean Dim str As String ret = True 'ソフト改行文字を付加 Call SendMessage(Text1.hwnd, EM_FMTLINES, 1&, ByVal 0&) str = Text1.Text If InStr(str, vbCr & vbCr & vbLf) = 0 Then MsgBox "失敗!" ret = False End If 'ソフト改行文字を削除 Call SendMessage(Text1.hwnd, EM_FMTLINES, 0&, ByVal 0&) If ret = True Then MsgBox "成功" End If End Sub  テキストボックスの横幅をある程度狭くし、複数行になるよう適当に文字を入力しボタンをクリックすると、ほとんど成功するのですが、確かに20回に1回くらい失敗します。  失敗した際は何度ボタンをクリックしても失敗します。逆に成功した文字列でなんどもボタンをクリックしても成功しか帰ってきません。  試した環境   WindowsXP Pro SP2、Windows2000 SP4  なんとも法則性も見つからず、途方に暮れております。決方法やこんな事象ご存知でしたら助けて頂けないでしょうか。よろしくお願い致します。  

質問者が選んだベストアンサー

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.3

たぶん EM_SETWORDBREAKで EditWordBreakProcを登録してから EM_FMTLINESを設定して使うのだろうと思いますよ ちょっと試してみたんですが EditWordBreakProcを設定した後IDEがクラッシュしてしまう現象が出てますので確信はないんですけど ・・・ 判断は vbCr vbCr vbLf の並びでチェックでいいと思います

imobito
質問者

お礼

 教えて頂いたキーワードを元に、サンプルなどを作成して確認したのですが、やっぱり失敗してしまいます。  サンプルですが、手元に「VisualBasic300の技」という本があり、そのなかに「ワードラップを抑止する」という項目があったので、まずはそのコードで実行してみたのですが、redfox63さんと同じようにIDEが強制終了してしまいました。  HP等を検索してワードラップを抑止するコードは確認でき、そこにソフト改行文字を挿入するコードを加えたのですが、やっぱり失敗してしまいました。  いろいろ試したところ、以下のような状態でソフト改行文字を入れようとするとこちらでは必ず失敗してしまいます。  ・スケールモード Twip  ・テキストボックス width=915 Height=1935  ・文字列 「oooooooooooooooooooooooaaaaa」(コピペだと成功します)  

imobito
質問者

補足

サンプルは以下のように作ってみました Private Const EM_FMTLINES = &HC8 'ソフト改行文字を設定/削除する定数 Private Sub Command1_Click() Dim ret As Boolean Dim str As String ret = True 'ソフト改行文字を付加 Call SendMessage(Text1.hwnd, EM_FMTLINES, 1&, ByVal 0&) str = Text1.Text If InStr(str, vbCr & vbCr & vbLf) = 0 Then MsgBox "失敗!" ret = False End If 'ソフト改行文字を削除 Call SendMessage(Text1.hwnd, EM_FMTLINES, 0&, ByVal 0&) If ret = True Then MsgBox "成功" End If End Sub Private Sub Form_Load() Call NonWordrap(Text1) End Sub -------- 以下標準モジュール ----------- Option Explicit Public Const EM_SETWORDBREAKPROC = &HD0 Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Function NonWordrap(Ctl As Control) Dim lngSubProcAddress As Long Dim lngWin32apiResultCode As Long ' コールバック関数のアドレスをLong値に変換 lngSubProcAddress = _ GetSubProcAddress(AddressOf EditWordBreakProc) ' ワードラップを抑止 lngWin32apiResultCode = _ SendMessage(Ctl.hwnd, _ EM_SETWORDBREAKPROC, _ 0, _ ByVal lngSubProcAddress) End Function ' コールバック関数のアドレスをLong値に変換 ' Public Function GetSubProcAddress _ (ByVal lngProcAddress As Long) As Long GetSubProcAddress = lngProcAddress End Function ' ' コールバック関数 - ワードブレイク処理 ' Public Function EditWordBreakProc _ (ByVal lpch As Long, _ ByVal ichCurrent As Long, _ ByVal cch As Long, _ ByVal action As Long) As Long End Function

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

#1でもおっしゃっている >If InStr(str, vbCr & vbCr & vbLf) = 0 Then はおかしくないですか vbCr & vbCr & vbLf は余り意味がないのでは? VBCrLfとか。 それに、「あれかまたはこれか」の意味ではこの書き方はできないと思います。 If InStr(str, vbCr ) = 0 Or InStr(str, vbLf) = 0 Then になりませんか。

imobito
質問者

お礼

解答ありがとうございます。 VBですと、&は結合という意味なので、ここの判定の意味は「str」の中に「VbCrVbCrVbLf」というコードがないかということをチェックしていることになりますので大丈夫・・・だと思います。 調べてみたところ、「VbCrLf」はユーザーが入力した改行、「vbCr & vbCr & vbLf」はソフト改行文字を意味するそうです。 If InStr(str, vbCr ) = 0 Or InStr(str, vbLf) = 0 Then こちらのコードでも試しましたが、やはり数回に1回失敗してしまいます。やっぱりSendMessageでソフト改行文字の挿入に失敗?してるみたいです。

  • tomiono1
  • ベストアンサー率38% (5/13)
回答No.1

自分の知識が低いので見当違いなことを言っていたら、申し訳ありません。 判定ののところで「vbNewLine」を使用してみてはではいかがでしょうか?

imobito
質問者

お礼

早速の解答、ありがとうございます。 If InStr(str, vbCr & vbCr & vbLf) = 0 Then   ↓ If InStr(str, vbNewLine) = 0 Then 判定のところを上記のように変更してみたのですが、やっぱりだめでした。プログラムを使ってもらってる人からの指摘で判明したので、私のところの環境だけではないとは思うのですが・・・ SendMessage自体不安定なものなのでしょうか

関連するQ&A

  • VBAでIEの「ファイルのダウンロード」ダイアログを制御

    VBではなくVBAにて、IEの「ファイルのダウンロード」ダイアログを制御したいと思い、過去の同様の質問等を参考に下記のソースを作成して動かしてみましたが、「ファイルのダウンロード」画面で、「保存(S)」ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックができず、次に進むことが出来ませんでした。 手動で「保存(S)」ボタンを押下して、強制的に「名前を付けて保存」画面に遷移させた後プログラムを再開すると、同画面の「保存(S)」ボタンのクリックはできました。 同じロジックで「名前を付けて保存」画面の「保存(S)」は動くのに、「ファイルのダウンロード」画面の「保存(S)」が動かないのはなぜでしょうか。 どなたかおわかりになる方がいらっしゃいましたら、ご回答をお願いします。 ***使用環境*** OS: XP pro IE: 6 OFFICE:2002 ***以下作成したソース(エラー制御は省略)*** Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Sub Test() Dim ret1 As Long Dim ret2 As Long Const WM_COMMAND As Long = &H111 ret1 = FindWindow("#32770", "ファイルのダウンロード") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) ret1 = FindWindow("#32770", "名前を付けて保存") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) End Sub ***以上ソース終わり***

  • エクセルのマクロで改行挿入(Excel2002)

    セルの文字列に全角10文字(半角20文字)ごとに Chr(10) で改行を入れたいです。 全角10文字を越えてはダメ。 選択したセルに動作する物です。 - - - - - Sub 半角20改行_Click() Dim Tmp As Range, Cha As Long, Num As Long Dim STR As String, MdTmp As Variant, flg As Boolean For Each Tmp In Selection  For Cha = 1 To Len(Tmp.Value)   MdTmp = Mid(Tmp.Value, Cha, 1)   If MdTmp = vbLf Then    If flg = False Then STR = STR & MdTmp    Num = 0    GoTo NextRow   End If   If LenB(StrConv(MdTmp, 128)) = 1 Then    Num = Num + 1   Else    Num = Num + 2   End If   ' この↓(20)で改行文字数変更   If Num >= 20 - 1 Then    STR = STR & MdTmp & vbLf    flg = True    Num = 0   Else    STR = STR & MdTmp    flg = False   End If NextRow:  Next  Tmp.Value = STR  STR = ""  Num = 0 Next For Each Tmp In Selection  If Right(Tmp, 1) = Chr(10) Then   Tmp.Value = LeftB(Tmp, LenB(Tmp) - 2)  End If Next End Sub - - - - - - これだと あいうえおかきくけこさしすせそ ↓↓ あいうえおかきくけこ ←全角10改行 さしすせそ <成功!> あいうえお(かきくけこさし)すせそ ↓↓ あいうえお(かきくけ ←全角9.5改行 こさし)すせそ <成功!> あいうえお(かきくけ)こさしすせそ ↓↓ あいうえお(かきくけ ←全角9.5改行 )こさしすせそ <失敗!!> こうなってほしい↓。 あいうえお(かきくけ) ←全角10改行 こさしすせそ 改行の狭間に全角文字が来た場合は全角9.5文字ごとに改行。 それ以外は全角10文字ごとに改行。 このようにする物を教えてください。

  • WinAPIで電卓をクリック

    現在、WinAPIを勉強しており、練習としてVBAを用いて、電卓アプリのボタンをクリックしようとしています。 キーを送るのではなく、クリックで行いたいたいと 考えています。 ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックできず、EditBoxに数字が 入りません。 どのようにすればよいのかご教授ください。 よろしくお願い致します。 環境: WinXP home、 Excel2002、Win付属アプリの電卓v5.1 ---作成したプログラム---- '標準モジュールの中身 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Sub Main() Dim lngWindWnd As Long 'ウィンドウハンドル Dim ret As Long Dim hCalc As Long 'アプリケーションタイトルより、ウィンドウハンドルを得ます lngWindWnd = FindWindow(vbNullString, "電卓") '8ボタンのハンドル(確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub

  • windows7のエクスプローラをVBAで操作-2

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラのフォルダパスの右のボタン(添付ファイル参照)をクリックすべく、コーディングしたものです。 最後のSendMessage(hwnd, BM_CLICK, 0, 0) でクリックしたいのですが、その前にボタンのハンドルが取得できません。SDKのInspect Objectsで調べると、このボタンはClass="ToolbarWindow32"でName="前の場所"ですが、NativeWindowHandleが表示されず、Legacy.IAccessible.ChildID=1となっています。 このようなウィンドゥは別のやり方(IAccessible?)でないとクリックできないように感じていますが如何せん知識がありません。 どうしたらできるか、アドバイスよろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long Const BM_CLICK = &HF5 Private hwnd As Long Sub Click_button() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ToolbarWindow32", vbNullString) ' この次が分からない。 RC = SendMessage(hwnd, BM_CLICK, 0, 0) end sub

  • excelVBAからC#へsendmessage

    excelのVBAから文字列をsendmessageで C#のプログラムに文字列を渡せないかと考えています。 ネットで調べつつなんとか作ってみたのですが、 どうしてもうまく動作しません。 変な文字列が表示されてしまいます。 どこがおかしいか教えて頂けないでしょうか。 windows7、Excel2010、.netFramework4になります。 ※※※excel VBA側プログラム※※※※※※※※※※※※ //外部functionを使いますよ Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _ (ByVal hwd As Long, ByVal Msg As Long, ByVal wpara As Long, lpara As COPYDATASTRUCT) As Long //構造体 Public Type COPYDATASTRUCT dwData As Long cbData As Long lpData As String End Type //メッセージを送信するsub Public Sub sousin() Dim result As Longv Dim hWnd As Long Dim cds As COPYDATASTRUCT Dim str As String Dim strby() As Byte Dim length As Long  ~ ウィンドウハンドルの取得 ~ str = "test" strby = StrConv(str, vbFromUnicode) length = UBound(strby) - LBound(strby) + 1 cds.dwData = 0 cds.lpData = str cds.cbData = length result = SendMessage(hWnd, WM_COPYDATA, 0, cds) End Sub ※※※C#側プログラム※※※※※※※※※※※※※※※ //構造体 public struct COPYDATASTRUCT { public long dwData; public long cbData; public string lpData; } //WndProc関数 protected override void WndProc(ref Message m) { switch (m.Msg) { case WM_COPYDATA: COPYDATASTRUCT mystr = new COPYDATASTRUCT(); Type mytype = mystr.GetType(); mystr = (COPYDATASTRUCT)m.GetLParam(mytype); label1.Text = mystr.lpData;           ←※無茶苦茶な文字列になります break; } base.WndProc(ref m); }

  • VBAでSetTextColorがうまくいかない

    EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------

  • VBAのリストボックスで、横スクロールバーを表示するには?

    お世話になります。 今、Excel_VBAで、あるデータをリスト表示にしているのですが、ながいデータになりますので水平スクロールバーをつけたいと思います。 標準のプロパティにはないので、"SendMessage"APIを使用し、コーティングをしているのですがうまくいきません。 [標準モジュール] Public Declare Function SendMessage Lib "user32" Alias "SendMessageA"(ByVal hwnd As Long, ByVal wMsg As Long,ByVal wParam As Long, lParam As Long) As Long [フォーム/ボタンクリックイベント] Private Sub Form_Load() List1.AddItem "あああああああああああ" List1.AddItem "いいいいいいいいいいい" List1.AddItem "ううううううううううう" lRtn = SendMessage(List1.hwnd,LB_SETHORIZONTALEXTENT, 240, 0)              End Sub 以上を実行すると、上記の"List1.hwnd"のhwndの部分で エラーになってしまいます。 エラー内容は、「メソッドまたはデータメンバがみつかりません」です。 宜しくお願い致します。

  • SendMessageについて

    VERSION:VB6.0 SendMessageを使用しSQLPlusに対して文字列を送りたいのですが巧くいきません。 ↓が自身が作成したSendMessageを使用しているプログラムの一部なのですが、おかしな点や別な方法があればご教授お願いします。 '別アプリにメッセージを送る Declare Function SendMessageStr Lib "user32.dll" _ Alias "SendMessageA" (ByVal hWnd As Long, ByVal MSG As Long, _ ByVal wParam As Long, ByVal lParam As String) As Long Dim pId As Long 'プロセスID pId = Shell("SQLPlusのアドレス" & " /nolog", 1) SendMessageStr pId, WM_SETTEXT, 0, "送信する文字列" というプログラムです。 SQLPlusは起動するのですが文字列がSQLPlus側に送れず困っています。 どうかよろしくお願いします。

  • 「&HFFFF」「&H1A」とは?

    はじめまして。 vb6.0の開発をしている者です。 表題にもありますように、「&HFFFF」「&H1A」は何を指しているのでしょうか? 実際は以下のように記述しています。 l = SendMessage("&HFFFF", "&H1A", 0, "windows") Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lparam As String) As Long 初歩的な質問で申し訳ないのですが、なかなかこれだ!という情報を見つけれずにいます。よろしくお願いします。

  • windows7のエクスプローラをVBAで操作-1

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラの現在のフォルダパスが表示されるところに(添付ファイル参照)文字を入れるものです。 最後のSendMessageAnyで1が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。 なおハンドルの値はSDKのInspect Objectsで確認していますので、正しく取得できていると思っています。 よろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessageAny Lib "user32.dll" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal MSG As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long Const WM_SETTEXT = &HC Private hwnd As Long Private FOLDER As String Sub Put_folder_name1() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) FOLDER = "\\xx.xx.xx.xx\test" RC = SendMessageAny(hwnd, WM_SETTEXT, 0, ByVal FOLDER) end sub

専門家に質問してみよう