• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：シリアル通信：オフライン時にうまく終了してくれません）

シリアル通信：オフライン時にうまく終了してくれません

taisuke555の回答

  • ベストアンサー
回答No.1

ぱっと見の回答ですので間違っているかもしれませんが・・・ 試しに、 Private Sub Timer1_Timer() 　　Debug.Print "Timer Start" 　　Timer1.Enabled = False 　　Call CheckPrint 　　Timer1.Enabled = True 　　Debug.Print "Timer End" End Sub として実行してみてください。 [Timer End]がでて、[Timer Start]がでるまでの間に、 終了ボタンを押せば、うまく終了するのではないかと思いますが、どうでしょうか？ [Timer Start]がでて、[Timer End]がでるまでの間は、 CheckPrintの中にDoEventsがあるので終了する事はできますが、 プログラムは、Do ... Loopを回っています。 TimeOutでDo ... Loopを抜けると、 Timer1.Enabled = Trueになるので またTimerイベントが発生して終了できないのではないでしょうか？ それを回避する方法は、いくつかあると思うのですが、 （例えば、 Private Sub Form_Unload(Cancel As Integer) 　　Timer1.Interval = 0 　　MSComm1.PortOpen = False End Sub にするとか（これは即終了とはいきませんが）） そもそもTimerイベントを用いる必要があるのでしょうか？ Private Sub MSComm1_OnComm()の中の ・・・・ BUF = MSComm1.Input この部分で、CheckPrintの中を（内容はよくわかりませんが） 実行したらいいのでは？と思いました。 細かい事がわからないので、全く違っていたらすみません。

leftovers
質問者

お礼

回答に心から感謝します。 細かい所まで気づいてくださってありがとうございます。本当に感謝です。様々なサイト様を巡っていても全然わかりませんでした。ウチの部署はプログラマもどき(気取り)の自分1人しかVBをいじってないので質問させていただきました。 CheckPrint()に続きがありまして、この後、Formに表示する部分(プリンタの状態(リボンエラー、ヘッドオープン等)を表示する)があります。つまりForm上にあるオブジェクトなり、コントロールが参照されます。 貴殿のおっしゃる通りで、Timer StartとEndの間で終了させればOKです。また、FormがUnloadされていてもプログラムは走っているようです。多分Doeventsで制御が戻ってくるのでしょう。それで、このDoeventsはよくわかりませんが、Formの情報も持っているのか、Form上にあるオブジェクトなり、コントロールが参照されると、Form_Loadに飛んでってしまうのです。それで再ロードされて、でもLoad中はVisibleはいじってないのでFalseのまま、裏で残ってしまうようです。で、プロセスが残りっぱなしになってしまうのです、というのが推測ですが結論が出ました。貴殿のおっしゃることで間違いないと思います。(ここまで結論付けるには貴殿の回答あってこそですが) また、Timerコントロールを使うのは単なる思い付きでして、昔GPIBなるものをいじってまして、その時にTimerコントロールで計測器を制御していたもんですから… お客にリアルタイムでプリンタの状態を見ることはできないかということを受けてでした。」 Timerコントロールはあまり使うものではないということを調べて知りましたので気をつけたいと思います。 一応、リファレンス通り、静的なLoadフラグを設けてDoeventsのすぐ下にLoadフラグがFalseだったらExit Subなる逃げ業(?)を使い、Timer1_TimerでもLoadフラグがFalseだったらTimer1を無効にしました。一切Formの「フォ」の字も使っておりません。あまり美しくはありませんが、完成にもっていっています。 この度は本当に感謝ですし、明日から定時に帰れるという喜びが大きいですよ。

この回答がついた質問に戻る
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 画像のランダム表示

    初心者なのですがVisual Studio6.0でもぐらたたきゲームを利用した作品を現在制作しています。内容は決まった画像がランダムでImageコントロールに表示され、それをクリックできると画像が変わり得点加算、クリックできないと画像が変わり減点というゲームです。現在Imageコントロールに決まった画像を呼び出す処理が完成しました。そして追加機能としてクリックできたらボーナスポイントの画像をImageコントロールに何分の何かの確率で表示させたいのですがわからない状態です。ちなみに画像は私のパソコンのDドライブから呼び出して表示させています。 どういった命令文を打ったら良いのかわかる方教えて下さい。宜しくお願いします。 こちらがプログラムです。 Option Explicit Const MinImgAry = 0 Const MaxImgAry = 15 Const GameTime = 15 Dim HitFlg As Integer Dim TEN As Integer Dim HoleNum As Integer Dim IconAry(2) As String Private Sub Command1_Click() Command1.Enabled = False Option1.Enabled = False Option2.Enabled = False Option3.Enabled = False HitFlg = 0 TEN = 0 Text1.Text = Str(TEN) Timer1.Enabled = True Timer2.Enabled = True End Sub Private Sub Command2_Click() Form1.Show End Sub Private Sub Form_Load() Dim StrPath As String StrPath = App.Path If Right(StrPath, 1) <> "\" Then StrPath = StrPath + "\" End If IconAry(0) = "D:制作\5\画像１.bmp" IconAry(1) = "D:制作\5\画像２.bmp" IconAry(2) = "D:制作\5\画像３.bmp" End Sub Private Sub Image1_Click(Index As Integer) Image1(Index).Enabled = False HitFlg = -1 End Sub Private Sub Option1_Click() Timer1.Interval = 1000 End Sub Private Sub Option2_Click() Timer1.Interval = 800 End Sub Private Sub Option3_Click() Timer1.Interval = 500 End Sub Private Sub Timer1_Timer() Static CtlFlg As Integer Select Case CtlFlg Case 0 Image1(HoleNum).Enabled = False Image1(HoleNum).Visible = False HoleNum = Int((MaxImgAry - _ MinImgAry + 1) * Rnd + MinImgAry) Image1(HoleNum).Picture = _ LoadPicture(IconAry(0)) CtlFlg = 1 Image1(HoleNum).Visible = True Image1(HoleNum).Enabled = True Exit Sub Case 1 Image1(HoleNum).Enabled = False If HitFlg Then HitFlg = 0 Image1(HoleNum).Picture = _ LoadPicture(IconAry(2)) TEN = TEN + 1 Text1.Text = Str(TEN) Else Image1(HoleNum).Picture = _ LoadPicture(IconAry(1)) TEN = TEN - 1 Text1.Text = Str(TEN) End If CtlFlg = 0 Exit Sub End Select End Sub Private Sub Timer2_Timer() Static TimeCnt As Long TimeCnt = TimeCnt + 1 If TimeCnt <> GameTime Then Exit Sub End If Timer1.Enabled = False Timer2.Enabled = False MsgBox "おしまい" TimeCnt = 0 Command1.Enabled = True Image1(HoleNum).Enabled = False Image1(HoleNum).Visible = False Option1.Enabled = True Option2.Enabled = True Option3.Enabled = True End Sub

  • タイマーがうまく動かない

    VB6.0（SP5）で、バッチファイルを実行後、5秒待つようにしたいのですが、うまく動きません。 Dim ping_count As Long Private Sub Command1_Click() Shell ("executeping.bat") Timer1.Interval = 1000 Timer1.Enabled = True Do Text1.Text = "ただいま実行中" Timer1_Timer Loop Until ping_count = 5 Text1.Text = "終了" Timer1.Enabled = False End Sub Private Sub Timer1_Timer() ping_count = ping_count + 1 Text1.Text = "ただいま実行中" End Sub デバックで動かすと、ちゃんとループを5回繰り返してテキストボックスに「終了」と表示するのですが、実行するといきなり「終了」を表示してしまいます。 ループの中のTimer1_Timerをコメントにすると、デバックでは延々ループを続け、実行するとフリーズしてしまいます。 そもそもタイマーの使い方が間違っているのでしょうか？ 教えてください。よろしくお願いします。

  • VB6.0のGPSシリアル通信について

    はじめまして。 VB6.0で、GPSシリアル通信を行っています。 シリアル設定は、MSComm1.Settings = "4800,n,8,1" にしています。 1秒毎にGPSデータは受信でき、すべて受信できています。 ただし、このGPSデータは、1秒間に下記のように6行分受信されます。 $GPRMC,131850,A,3603.5404,N,14008.5746, $GPGGA,131850,3603.5404,N,14008.5746, $GPGSA,A,3,27,09,02,05,21,29,10,15,,,, $GPGSV,3,1,11,27,27,193,33,09,13,199, $GPGSV,3,2,11,21,18,317,23,29,14,259,22, $GPGSV,3,3,11,07,01,033,00,18,00,295,00,28 そこで、上記6行分のデータのうち、初めの2行分だけを取り出したいと思っていますが、どうもうまくいきません。 どのようにすれば、初めの2行分だけを取り出すことができるでしょうか？ 下記がソースです。 Private Sub MSComm1_OnComm() Dim Buffer1 As Variant Select Case MSComm1.CommEvent Case comEvReceive Buffer1 = MSComm2.Input If (InStr(Buffer1, "GPRMC")) Then Debug.Print Buffer1; Else (InStr(Buffer1, "GPGGA")) Then Debug.Print Buffer1; End If End Sub どなたか教えてください。 よろしくお願いします。

  • VB6.0でMSChartをタイマーを使い徐々にグラフを伸ばしたい。

    VB6.0でMSChartをタイマーを使い徐々にグラフを伸ばしたいのですが、上手くいきません。コマンドボタンを使いクリックしたと同時にタイマーを作動させて、ある値までグラフを増加させたいと思っているのですが、初心者同然なので詳しくお願いします。 Dim dat(4, 3) As Integer Dim a As Long Private Sub Command1_Click() With MSChart1 .chartType = VtChChartType3dBar .ColumnCount = 3 .RowCount = 4 For i = 1 To .RowCount For j = 1 To .ColumnCount .Column = j .Row = i .Data = dat(i, j) Next j Next i .DataGrid.ColumnLabel(1, 1) = "(1)" .DataGrid.ColumnLabel(2, 1) = "(2)" .DataGrid.ColumnLabel(3, 1) = "(3)" .DataGrid.RowLabel(1, 1) = "1月～3月" .DataGrid.RowLabel(2, 1) = "4月～6月" .DataGrid.RowLabel(3, 1) = "7月～9月" .DataGrid.RowLabel(4, 1) = "10月～12月" .Visible = True End With Timer1.Enabled = True End Sub Private Sub Form_Load() a = 0 MSChart1.Visible = False End Sub Private Sub MSChart1_OLEStartDrag(Data As MSChart20Lib.DataObject, AllowedEffects As Long) End Sub Private Sub Timer1_Timer() a = a + 10 dat(1, 1) = a: dat(1, 2) = 100: dat(1, 3) = 110 dat(2, 1) = 30: dat(2, 2) = 110: dat(2, 3) = 110 dat(3, 1) = 40: dat(3, 2) = 120: dat(3, 3) = 110 dat(4, 1) = 50: dat(4, 2) = 130: dat(4, 3) = 110 If a = 100 Then Timer1.Enabled = False End If End Sub

  • VB6でスロットを作成したい

    VB6歴2ヶ月の初心者です。 フォーム上に ラベルコントロールが三つ コマンドボタンが二つ タイマーコントロールが一つ あります。 タイマーのプロパティは Enabled False Interval 10 です。 スロットを作成したいのですが、 ボタン1を一回押すごとに左からスロットが回り、 最後にボタン2で動きを止めたいのです。 一応自分でも書いてみたのですが、ここで行き詰まりました。 ウワァァァァァァヽ(｀Д´)ノァァァァァァン! Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Dim slot As Integer slot = Int(Rnd(1) * 9 + 1) Label1.Caption = slot End Sub 思い通りに動かすにはどんなコードにしたらいいですか？

  • 16進数の変換

    visualbasic6.0で加速度センサーから傾きを検出するプログラムを作りたいのですが、初心者のため手探りでやっている状態です。 センサーからの信号は１６進数で４バイトずつ送られてきます。 これを１０進数に直して、前の２バイトと後ろの２バイトを分けて表示したいのですが解かりません。以下が現段階のコードの１部です。 Private Sub MSComm1_OnComm() Dim bytBuf() As Byte Dim strDisp As String Dim lngCount As Long Select Case MSComm1.CommEvent Case comEvReceive If List1.ListCount = 0 Then MSComm1.InBufferCount = 0 End If Do bytBuf = MSComm1.Input strDisp = "" For lngCount = LBound(bytBuf) To UBound(bytBuf) strDisp = strDisp & Right("00" & Hex(bytBuf(lngCount)), 2) & " " Next List1.List(0) = List1.List(0) & strDisp Loop While MSComm1.InBufferCount <> 0 End Select End Sub

  • Tickイベントについての質問

    1秒間のループ回数を得るために下記のようなコードを記述したのですが、Tickイベントが発生せずループから抜けません。以前はVB6(Timer1_Timerイベント)を使用していたのですが、何の問題もなく使用出来ていました。誰か分る方、ご教授下さい。もちろんInterval=1000です。 '1sec間に繰り返されるループ回数 Private mlng1SecTimeCount As Long '1sec経過フラグ Private msht1SecFlg As Short '(省略) Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 'ディレイタイム設定 DELAY_TIME_SETTING() End Sub Private Sub DELAY_TIME_SETTING() 'ディレイタイム設定 '解説:1sec間に実行されるループ回数の算出。 'ループ回数格納用変数 Dim lngLoopCount As Long 'タイマー1起動 Timer1.Enabled = True Do Until msht1SecFlg = 1 lngLoopCount += 1 Loop 'タイマー1停止 Timer1.Enabled = False 'データ保存 mlng1SecTimeCount = lngLoopCount End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick '解説:1sec経過後にインクリメント。 'インクリメント msht1SecFlg += 1 End Sub 以上よろしくお願い致します。

  • エクセルでマクロの進行状況を表示あるには

    下記のマクロはURLからタイトルを抽出するものなのですが 件数が何千件とあり、進行状況が分かれば便利かなと思います。 表示方法はどのような形でも構わないのですが、ご教授願います。 色々調べたのですがうまくいかず困っております。 ちなみに私は全くの度素人であり、マクロもネット上で検索して 見つけたものをそのまま使用しております。 －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Private Sub CommandButton1_Click() Dim url As Range Dim Http, buf As String Set Http = CreateObject("MSXML2.XMLHTTP") Set url = Range("A2") Do While (url.Value <> "") Http.Open "GET", url.Value, False Http.Send With CreateObject("ADODB.Stream") .Open .Type = 2 'adTypeText .Charset = "unicode" .Writetext Http.ResponseBody .Position = 0 .Charset = "utf-8" buf = .ReadText() .Close End With 'msgbox buf url.Offset(0, 1).Value = getTitle(buf) Set url = url.Offset(1, 0) Loop Set Http = Nothing End Sub Private Function getTitle(buf As String) As String Dim pos1 As Long, pos2 As Long pos1 = InStr(1, buf, "<title>") If pos1 = 0 Then pos1 = InStr(1, buf, "<TITLE>") If pos1 = 0 Then getTitle = "" Exit Function Else pos2 = InStr(pos1 + 7, buf, "</TITLE>") End If Else pos2 = InStr(pos1 + 7, buf, "</title>") End If getTitle = Mid(buf, pos1 + 7, pos2 - pos1 - 7) End Function Private Sub タイトル抽出_Click() End Sub －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 宜しくお願い致します。

  • グーグルに登録されているかをチェックする場合

    エクセルのE列にURLがあるとします。（数は500～1000ぐらい） F列には、Ｅ列にあるURLをグーグルで検索し、検索結果がある場合は、「○」ない場合は「×」で判定します。 G列には、グーグルで検索結果の約○○件、あるいは○件、これら○に入る数字を取得したいです。 そこで、以前、同じことを教えてもらったのですが、グーグルの使用が変更になったせいかすべて検索結果が「×」判定となってしまいました。 そのコードが下記なのですが、どこを修正すればいいのか教えてください。 よろしくお願いします。 '標準モジュール Private Const SKEY As String = "http://www.google.co.jp/search?hl=ja&q=" Public Sub GoogleCheckers() Dim c As Range Dim buf As String Const qt As String = "" With ThisWorkbook.Sheets("登録チェック") For Each c In Range("E6", Cells(Rows.Count, 5).End(xlUp)) If c.Value <> "" Then Application.ScreenUpdating = False buf = UrlEncode(c.Value) buf = SKEY & buf ItemCehck buf, c Application.ScreenUpdating = True End If Next End With End Sub Private Sub ItemCehck(ByVal strURL As String, iRng As Range) Dim rng As Range Dim objHTTP As Object Dim i As Long, j As Long Dim c As Variant Dim httpLog As String Dim msgbuf As Variant Dim LimitNum As Long On Error GoTo ErrHandler Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") objHTTP.Open "GET", strURL, False objHTTP.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-JA; rv:1.9.2.12)" objHTTP.Send If Err.Number = 0 Then If objHTTP.Status = 200 Then httpLog = objHTTP.ResponseText Call ContentsCheck(httpLog, iRng) ElseIf objHTTP.Status >= 400 Then iRng.Offset(, 1).Value = "アクセスエラー" End If Else iRng.Offset(, 1).Value = "?" End If Exit Sub ErrHandler: iRng.Offset(, 1).Value = "不明" End Sub Private Sub ContentsCheck(httpLog As String, rng As Range) 'rev:101226 Dim i As Long, j As Long Dim buf As Variant Const STXT As String = "検索オプション</a></div><div><div id=resultStats>" i = InStr(1, httpLog, STXT, 1) If i > 0 Then buf = Mid(httpLog, i + Len(STXT), 50) j = InStr(1, buf, "件<nobr>", 1) buf = Mid(buf, 1, j) buf = Replace(buf, "約", "") buf = Replace(buf, "件", "") End If If CLng(Val(buf)) > 0 Then rng.Offset(, 1).Value = "○" rng.Offset(, 2).Value = buf Else rng.Offset(, 1).Value = "×" End If End Sub Private Function UrlEncode(ByVal sText As String) As String Dim buf As String If Len(sText) = 0 Then Exit Function With CreateObject("ScriptControl") .Language = "JScript" buf = .CodeObject.encodeURI(sText) buf = Replace(buf, ":", "%3A", , , 1) buf = Replace(buf, "/", "%2F", , , 1) UrlEncode = buf End With End Function

  • GetCursorInfoの使い方

    GetCursorInfoの使い方について教えてください。現在は下記のようにしていますが返り値に0しかはいりません。なにがおかしいかご指導お願いします。m(._.)m ペコッ --モジュール-- Public Declare Function GetCursorInfo Lib "user32" (pci As CURSORINFO) As Long Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer Public Type POINTAPI X As Long Y As Long End Type Public Type CURSORINFO cbSize As Long flags As Long hCursor As Long ptScreenPos As POINTAPI End Type Public Field As CURSORINFO --Form1-- Dim lRet As Long Private Sub Timer1_Timer() If GetAsyncKeyState(vbKeyHome) Then lRet = GetCursorInfo(Field) End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する