• ベストアンサー
  • 困ってます

ExcelでTelnetを動かしたい

長々と書いて申し訳ありませんが、困っています。 使用環境はWindows 2000です。開発環境というかexcel2000のVBAでコーディングしています。 で問題点が2点ありまして、 (1)EnumWindowsの所で止まるのですが、AddressOf演算子はexcel2000でも使えますよね。  コンパイルエラー Sub、Function、または Property が必要です というエラーで止まります。  何か使用方法が間違っていますでしょうか? (2)テキストボックスを2つ用意してあるので、それを引数としてtelnetでつなぐパソコンを  選べるようにしたいのですが引数でうまく渡せません(現状はコメントアウトしている部分です)。 Private Sub CommandButton1_Click() box1 = TextBox1 box2 = TextBox2 'ipnum = "telnet xxx.xxx."box1"."box2 '待ち時間処理用の時刻の変数 newHour = Hour(Now()) newMinute = Minute(Now()) Shell "cmd.exe" lRet = Shell("C:\WINNT\system32\cmd.exe", vbNormalFocus) newSecond = Second(Now()) + 5 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime Call EnumWindows(AddressOf Rekkyo, 0) lRet = FindWindow(vbNullString, "C:\WINDOWS\system32\cmd.exe") Call SendMessage(lRet, WM_SYSCOMMAND, WM_MAXIMIZE, ByVal 0&) Call PostMessageStrings("telnet xxx.xxx.xxx.xxx") 'Call PostMessageStrings(ipnum) Call PostMessageStrings("xxx.bat") Call PostMessageStrings("exit") Call PostMessageStrings("exit") End Sub Public Function PostMessageStrings(strPost As String) Dim i As Integer '1文字ずつ分解して送信 For i = 1 To Len(strPost) Call PostMessage(lRet, &H102, Asc(Mid(strPost, i, 1)), 0) Next '送信後に改行コードを送信 Call PostMessage(lRet, &H102, 13, 0) End Function 標準モジュールに、こんな感じでAPI関数を記述してあります。 他のAPIも記述してありますが、割愛してあります。 'ウィンドウのハンドルの取得 Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long 誰か教えてください。よろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数5
  • 閲覧数4213
  • ありがとう数4

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

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

>デバックモードで値を見ているとlRetに何も入っていないのでここが悪いと思うのですが FindWindow() の戻り値が、でしょうか? それとも、PostMessageStrings() の中で、でしょうか? よく見てみると lRet がどこで宣言されているのかわかりませんね。 Sub CommandButton1_Click() の中で Dim lRet As Long と宣言しているのでしょうか? そうだとすると、PostMessageStrings() の中の lRet は PostMessageStrings() の中で暗黙に宣言されたものとみなされてしまうので、PostMessageStrings() の中 lRet は 0 になってしまいます。 (General) の (Declarations) で Private lRet As Long と宣言するか、PostMessageString() にウィンドウハンドルの引数を追加する必要があります。 だいたい、↓こんな感じですね。 (テキストボックスから取得するところはご自分で適当に直してください。) (General) - (Declarations) Private Declare Function FindWindowA Lib "user32" (ByVal cnm As String, ByVal cap As String) As Long Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMillsecounds As Long) Private Const WM_CHAR = &H102 Private Sub CommandButton1_Click() Dim lngRet As Long Dim hWnd As Long lngRet = Shell("cmd.exe", vbNormalFocus) Sleep 100 hWnd = FindWindowA(vbNullString, "C:\WINDOWS\system32\cmd.exe") SendString hWnd, "telnet xxx.xxx.xxx.xxx" End Sub Private Sub SendString(ByVal hWnd As Long, ByVal s As String) Dim i As Integer Dim c As String For i = 1 To Len(s) c = Mid(s, i, 1) PostMessage hWnd, WM_CHAR, Asc(c), 0 Sleep 10 Next i PostMessage hWnd, WM_CHAR, Asc(vbCrLf), 0 End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。 tsukasa-12rさんのソースを参考にしながら修正を加えたら動くようになりました。 telnetも無事に出来てしたい作業が出来るところまで確認できました。 ただ別の問題点も発生しまして、たまにコマンドプロンプトに渡す時に telnet xxx.123.456.789 の部分が telnet xxx.123.45.78 や telnet xxx.123.45.789 になってしまうバグが発生します。 どうも telnet xxx.123.455.788 みたいに同じ数字のときの起こる ようでして、困っています。 ただ自分のソースで言うところのipnumの変数の値をメッセージボックスで 表示させたところ、バグになる時でも telnet xxx.123.456.789 と表示されます。 後、困っているというか結果の確認が出きないので テルネット先で実行後にerrorlevelとかに入る値をどうにか取得できませんか? 注文が多くてすいません。自分でも調べてみます。

関連するQ&A

  • VBAで外部プログラム操作

    AccessVBAからTelnet操作を行いたく 苦肉の策で下記のような処理を組み込みました。 Private Sub Command1_Click()   Shell "cmd.exe"   stopTime 50   Call EnumWindows(AddressOf Rekkyo, 0)   lRet = FindWindow(vbNullString, "C:\WINDOWS\system32\cmd.exe")   Call SendMessage(lRet, WM_SYSCOMMAND, WM_MAXIMIZE, ByVal 0&)   Call PostMessageStrings("telnet hoge.hoge")   Call PostMessageStrings("username")   Call PostMessageStrings("passwd")   Call PostMessageStrings("テルネット上の処理")   Call PostMessageStrings("quit")   Call PostMessageStrings("exit") end sub Public Function PostMessageStrings(strPost As String)   Dim i As Integer   '1文字ずつ分解して送信   For i = 1 To Len(strPost)     Call PostMessage(lRet, &H102, Asc(Mid(strPost, i, 1)), 0)   Next   '送信後に改行コードを送信   Call PostMessage(lRet, &H102, 13, 0) End Function shell で起動したコマンドプロンプトのウィンドウが 最小化された状態で以降の処理が進められてしまいます。 何かいい案は無いでしょうか? もしくは、もっと効率よくtelnet操作できる方法は無いでしょうか? 以上よろしくお願いいたします。

  • Excel VBAでアプリのウィンドウ名取得

    WindowsXP, Excel2007で、ExcelからIE8にキーコードを送りたいです。 ネットで拾った以下のコードにより、 Option Explicit Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Function activate_win(win_name As String) As Long Dim hwindow As Long hwindow = FindWindow(vbNullString, win_name) If hwindow <> 0 Then SetForegroundWindow hwindow activate_win = hwindow End Function Call activate_win("ウィンドウ名") Sendkeys "ABC", True のような形で、メモ帳での動作は確認したのですが、 IEだとウィンドウがアクティブになってくれません。 おそらくウィンドウタイトルを間違えているのだと思われますが、 全角半角などを変えてみたりしても、どう見比べてみても間違いがわかりません。 見た目ではわからない、似た文字だが違うということではないかと思っています。 そこで、開いているアプリのウィンドウ名すべてをメモ帳に書き出すような (あるいは任意のアプリにペーストできるようにするような)コードはないでしょうか? よろしくお願いします

  • EnumWindowsのコールバック関数に文字列を

    VBAでのWindows API関数EnumWindowsの定義は下記になっています。 Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long そこで、コールバック関数(lpEnumFunc)へのパラメータ(lParam)に文字列を指定したくて定義を下記のように変更しましたが旨く行きません。(定義をこのように変更することが許されているかも分っていませんが)   変更前:ByVal lParam As Long   変更後:ByRef lParam As String EnumWindowsのコールバック関数へのパラメータに文字列を指定する方法があれば教えて頂きたくよろしくお願いします。

その他の回答 (4)

  • 回答No.5

>telnet xxx.123.456.789 >の部分が >telnet xxx.123.45.78 や telnet xxx.123.45.789 >になってしまうバグが発生します。 ANo.4 のソースには記述していましたが(説明はしていませんでしたが)、PostMessage() の呼出しごとに Sleep ( または wait ) を入れると回避できるようです。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。 確かに telnet xxx.123.45.78 みたいなバグが出なくなりました。 ただ、プログラムの待ち状態が長いと非常に使い勝手が悪いので、スリープ時間をうまく調整してみます。 色々とありがとうございました。

質問者からの補足

回答ありがとうございます。 やってみたいのですが、休日なので火曜日まで試せないのが残念です。 プログラムを途中まで止めておかないと、入力がうまくいかないのは分りますが、 telnet xxx.123.45.789 みたいになるパターンも同じ理由なんですか? 最後の文字とかが落ちてると納得いくのですが、途中が落ちてると理屈が合わない気がします。 何にせよ、火曜日になったら試してみます。 ありがとうございました。

  • 回答No.3

>最初に書いたようにEnumWindowsを標準モジュールに記述してありますが、そことは別に必要なんでしょうか? EnumWindows() の宣言をしている標準モジュールに Function Rekkyo() がある、ということですか? というか、もしかして、Function Rekkyo() をどこにも作成していないのではないですか? >ただの引数としてcmd.exeを渡すものだと思っていました。 というところから、Function Rekkyo() を作成していないのではないかという気がしてきました。 EnumWindows( Address CallBackProc ) というのは、OS に、「 Window を列挙してね。そして、列挙した Window ごとに、CallBackProc にウィンドウハンドルを渡して呼び出してね。」 というお願いをするというものです。CallBackProc ( 名称は別に何でも構わない ) はこちらで用意しておきます。が、 Public Function CallBackProc(ByVal Handle As Long) As Boolean の形式にしなければなりません。 というか、FindWindow() でウィンドウハンドルが取得できるのであれば、EnumWindows() は使用する必要はないんじゃないでしょうか。

共感・感謝の気持ちを伝えよう!

質問者からの補足

度々の解答ありがとうございます。 ご指摘の通り、EnumWindowsは関係なくてFindWindowの所でエラーが出てうまくいってなかったようです。 Function Rekkyo() は作成していなかったのですが、ウィンドウを列挙する必要性はないので作成していません。 問題はFindWindow() でウィンドウハンドルが取得できず、コマンドプロンプトに文字列がうまく渡せません。 標準モジュールにFindWindowは以下のように宣言してあります。 Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long デバックモードで値を見ているとlRetに何も入っていないのでここが悪いと思うのですが、どんな風に変えればいいんでしょうか? lRetをlongで宣言していたのが間違えたのかと思って、string等と色々と変えてみたのですがうまくいきませんでした。 stringだと数字が入るのにlongだと""(NULL値?)でした。 lRetに渡す所もcmd.exeにしたり、C:\WINNT\system32\cmd.exeにしたり色々といじっているのですが、値が渡せません。 FindWindowについても教えていただけるとうれしいです。

  • 回答No.2

では(2)の方を。。。 Private Sub CommandButton1_Click() Dim ipnum As String ipnum = "telnet xxx.xxx." & TextBox1.Text & "." & TextBox2.Text MsgBox ipnum 変数の型が分からなかったので勝手にStringとしました。 「.Text」で取れます。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

試してみたところ、うまくいきました。 ありがとうございます。 ただ、(1)の方がうまくいかないままなので、全体としては困ったままです。

質問者からの補足

こちらにも早々と解答を下さって、ありがとうございます。 既に帰宅してしまってすぐには試せないのですが、試してみたいことこの上ないです。 で、この形にすると変数にうまくまとめられるんですね。 FunctionにはStringで渡しているので、このまま使えそうです。 明日、早速試してみます。ありがとうございました。

  • 回答No.1

とりあえず (1) の方だけですが、 Call EnumWindows(AddressOf Rekkyo, 0) で指定する Function Rekkyo ですが、なぜか標準モジュールにおかなければならないようです。 (標準モジュールは VBA の画面でメニューの「挿入」からできます。)

共感・感謝の気持ちを伝えよう!

質問者からの補足

早速の解答ありがとうございます。 最初に書いたようにEnumWindowsを標準モジュールに記述してありますが、そことは別に必要なんでしょうか? AddressOf演算子をうまく理解していないのか、ただの引数としてcmd.exeを渡すものだと思っていました。

関連するQ&A

  • Excel VBAでIE「ダウンロードの表示」生成

     Internet Explorer で、「ダウンロードの表示」のDialogウィンドウをショートカット(Ctrl + J )を使って表示させたいのですが、Excel VBA で以下のコードで試したのですが、うまくいきません。どういうコードを書いたらよいのでしょうか?アクセスキーを使った方法では、「ツール」で N  に該当するのが「ダウンロードの表示」と「Send To Note」の2つあって起動できません。  よろしくお願いします。 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Const WM_KEYDOWN = &H100 Public Const WM_KEYUP = &H101 Public Const VK_CONTROL = &H11 Public Const VK_J = &H4A Public Const navOpenInNewTab = &H800 Sub Test() Dim objIE As Object Dim hWnd_objIE As Long Dim Ret As Long 'IE起動 Set objIE= CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "https://www.google.co.jp/", navOpenInNewTab Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Loop 'objIEのhWnd取得 hWnd_objIE = objIE.hwnd 'IEの親ウィンドウのhWnd取得する 'hWnd_objIE のウィンドウにPostMessageする Ret = PostMessage(hWnd_objIE, WM_KEYDOWN, VK_CONTROL, 0) Ret = PostMessage(hWnd_objIE, WM_KEYDOWN, VK_J, 0) Sleep 100 Ret = PostMessage(hWnd_objIE, WM_KEYUP, VK_CONTROL, 0) Ret = PostMessage(hWnd_objIE, WM_KEYUP, VK_J, 0) End Sub

  • VBAでのカーソル移動とマウスクリック

    業務上の単純作業の自動化のため、VBAから他のアプリケーションを操作することが目的です。 以前、ブラウザ上での作業の時に使用した、下記2つのAPIでは今回はマウスカーソルが指定した座標に動いてくれません、、、 Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) この2つのAPI以外で、カーソル移動とマウスクリックを実現する方法は何かありますでしょうか? 色々な方法を教えていただけるとVBAの勉強にもなり幸いです。 ' // 標準モジュール Option Explicit Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Private Type POINTAPI     x As Long     y As Long End Type Private Sub クリックテスト() Call SetCursorPos(216, 421) Sleep 400 Call mouse_event(&H2, 0, 0, 0, 0) Call mouse_event(&H4, 0, 0, 0, 0) End Sub

  • Formを動かせるようにしたい

    お世話になります。 OS XP PRO  VB6(SP5)で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。

  • [excel vba] マウスポインタの変更

    お世話になります。 excel vba でマウスポインタの変更を教えてほしいのですが、「Application.Cursor」で使用可能な  ・xlDefault  ・xlNorthwestArrow  ・xlIBeam   ・xlWait 以上の4つではなく、クロス型(+のような形)のポインタに変更することはできないでしょうか? 図形をコピー⇒貼り付けするタイミングでこのマウスポインタ型に変更できたらと思っています。 windowsAPIを使用した下記の方法では、一時的には可能ですが、マウスポインタを動かすと元に戻ってしまいます。 書き方、使用方法など間違っているのでしょうか。 -----winAPIを使用したソース--------------------------------------------------------- Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long Private Const IDC_CROSS = 32515& Sub CursorChangeTest() Dim i As Double Dim waitTime As Variant SetCursor (LoadCursor(0, IDC_CROSS)) 'ループ処理 For i = 1 To 5 waitTime = Now + TimeValue("0:00:01") Debug.Print "きました " & i Application.Wait waitTime Next i End Sub ------------------------------------------------------------------------------------ よろしくお願いします。

  • VBA ウィンドウの列挙 Win32 API

    http://d.hatena.ne.jp/cartooh/20090618 上記のページに記載されているVBAです。 動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。 どなたかコメントを付けていただけないでしょうか。 よろしくお願いいたします。 Option Explicit Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _ ByVal cch As Long) As Long Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long Const INDENT_KEY = "INDENT" Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam) End Function Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumWindowsProc = True If IsWindowVisible(hWnd) = 0 Then Exit Function End If Dim strClassName As String ' * 255 Dim strCaption As String ' * 255 strClassName = String(255, vbNullChar) strCaption = String(255, vbNullChar) GetWindowText hWnd, strCaption, Len(strCaption) GetClassName hWnd, strClassName, Len(strClassName) strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1)) strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1)) ActiveCell.Cells(1, 1).Value = Hex(hWnd) ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd) ActiveCell.Cells(1, 3).Value = strCaption ActiveCell.Cells(1, 4).Value = strClassName ActiveCell.Cells(2, 2).Activate Dim c As Collection Set c = lParam Dim indent As Long indent = c(INDENT_KEY) c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count indent = indent + 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c)) indent = c(INDENT_KEY) - 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY ActiveCell.Cells(1, 0).Activate End Function Sub hoge() Application.ScreenUpdating = False Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets(1) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim c As Collection Set c = New Collection c.Add 0, INDENT_KEY Dim ret As Long ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c)) c.Remove INDENT_KEY Set sht = ThisWorkbook.Worksheets(2) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim o As Variant For Each o In c ActiveCell.Value = o ActiveCell.Cells(2, 1).Activate Next Application.ScreenUpdating = True End Sub

  • Excel VBA 一定の数値以下で音を鳴らす

    一つのセル内の数値(VBAにより、1秒ごとに更新される流動的な数値です)において、-2以下になるとすぐにBEEP音が鳴る設定をしたいのですが、何故か1分ごとにしか鳴りません。 今のモジュールは、標準モジュールに Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long Sheet1に Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then If Range("Q6") < -2 Then Call Beep(2000, 500) Call Beep(2000, 500) End If End If End Sub と入力しています。 改善方法をどうかご教授願います。

  • 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 '-------------------------------------------------

  • BEEP音を再生したい

    下のドレミを再生したいのですが具体的にどのようにどこへ記載すれば再生できますか? Private Sub? Declare Function Beep Lib "kernel32" ( _           ByVal dwFreq As Long, _           ByVal dwDuration As Long _           ) As Long 上記のコードをSUB に記載するとエラーになります。 これがないとCALL Beepもエラーになります。 '=============================== Sub Test()  Call Beep(262, 500)  Call Beep(294, 500)  Call Beep(330, 500)  Call Beep(349, 500)  Call Beep(392, 500)  Call Beep(440, 500)  Call Beep(494, 500)  Call Beep(523, 500) End Sub VBA初心者です分かりやすくお願いします。

  • 64ビットエクセルでのAPI宣言/PtrSafe

    エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open() を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか? 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。

  • 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