[[20230831190035]]　『VBAから別ソフトの操作』（別アプリ操作）　ページの最後に飛ぶ

『VBAから別ソフトの操作』（別アプリ操作）

お世話になります。

VBAから別ソフトウェアの操作をしたいと思い、いろいろ調べながら以下の
コードを作成しました。

操作したいのは、印刷すると立ち上がるPC-FAXの画面です。
外部のソフトウェアを操作するにはどうしたらよいのでしょうか。

コードを実行すると「プロシージャの呼び出し、または引数が不正です」と表示されます。

Option Explicit

Sub FAX自動送信用()

Dim shW As Worksheet
Dim c As Range
Dim i As Long

'使用するプリンタを一時的に切り替える
'正式名称、ポート番号が必要

'win + R regedit
'HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices

'プリンタ名とポートが表示される

Application.ActivePrinter = "SHARP MX-3650FN FAX on Ne02:"

'MsgBox "一時的に切り替えたプリンタは「" & Application.ActivePrinter & "」"

Application.ScreenUpdating = False
Set shW = Sheets("作業_FAX") '作業用シート
shW.Cells.ClearContents '作業シートのクリア

With Sheets("見積依頼") 'データ元シート

    'D列のメーカー名の重複を排除して作業シートに抽出
    '.Columns("A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("作業_FAX").Range("A1"), Unique:=True
    Sheets("見積依頼").Range("D12:D162").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Sheets("作業_FAX").Range("A1"), Unique:=True

    'オートフィルター設定があればいったん解除
    If .AutoFilterMode Then .AutoFilter.Range.AutoFilter
    'あらためてオートフィルター設定
    .Range("D12").AutoFilter

    'ユニークになったメーカー名リストからメーカー名を１つずつ抽出
    For Each c In shW.Range("A2", shW.Range("A" & shW.Rows.Count).End(xlUp))

        For i = 2 To 6
            '抽出した品番の値でフィルタリングして印刷
            .AutoFilter.Range.AutoFilter Field:=4, Criteria1:=c.Value

            .Range("A2") = .Cells(i, 14)

                If .Range("A2") = 0 Then GoTo BreakLabel 'A2がゼロの時BreakLabelまで処理が飛ぶ

                .PrintOut '印刷
                '.PrintPreview 'テスト用印刷プレビュー

                Call FAX宛先入力

        Next i
BreakLabel:
    Next

    'オートフィルター解除
    .AutoFilter.Range.AutoFilter
End With

shW.Cells.ClearContents '作業シートのクリア
Application.ScreenUpdating = True
'MsgBox "印刷終了"

Sheet2.Range("D12").AutoFilter 4, "<>" '見積依頼 D12へフィルター設定空白を除外

MsgBox "印刷マクロ終了"

End Sub

Option Explicit

ーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub FAX宛先入力()

Dim WshShell
Dim rc As Long

'Set WshShell = CreateObject("WScript.Shell")

'rc = Shell("C:\Windows\System32\spool\drivers'\x64\3\SS0XUI.exe", 1)

ActiveSheet.Range("D2").Copy 'FAX番号のコピー

AppActivate ("相手先の選択"), [True] 'PC-FAX画面を最前面に呼び出す

'各キーを押していく
SendKeys "{TAB}"

SendKeys "{TAB}"

SendKeys "^v", True '貼り付け Ctrl + V

SendKeys "{ENTER}" '次へ

SendKeys "{ENTER}" '完了(送信する)

End Sub

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

エクセルのレイアウトは以下のようになっています

E～M列は何も入力されていない
N1　宛先のカウント　VBAで使用するためのもの

メーカーによって宛先の数が異なる
メーカーAの場合、宛先は3件
メーカーBの場合、宛先は2件など

N2～N6まではVLOOKUPでメーカー名を検索値として宛先を表示している

N2　宛先1
N3　宛先2
N4　宛先3
N5　宛先4
N6　宛先5

 　　　A　　　　　　　　　B　　　　　　C　　　　　　　　D　　　　　E　F　G　H　I　J　K　L　M　　N
1　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　2→宛先のゼロの数を表示　　　　　　
2　　A2へ宛先がコピペされる　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　田中商事
3　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　山田商事
4　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　林商事
5　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　鈴木商事
6　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　0
7　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　0
8
9
10
11　A列　　　　　　B列　　　　　　　　C列　　　　　　　D列
12　NO　　　　　　品名　　　　　　　型式　　　　　　メーカー　この列にフィルタあり
13　1　　　　　　ドリル　　　　　　　φ5　　　　　　　　A
14　2　　　　　　ラチェット　　　　　L12　　　　　　　　B
15　3　　　　　　ドライバー　　　　トルクス　　　　　　　C
（別アプリ操作） 2023/08/31(木) 21:26:10

 >コードを実行すると「プロシージャの呼び出し、または引数が不正です」と表示されます。
 何処ででしょう?

 想像するに、
 ご提示のコードでそのエラーが出そうな箇所は多分↓ココだと思うんですけど(違ったら聞き流して ^^;)

 >AppActivate ("相手先の選択"), [True] 'PC-FAX画面を最前面に呼び出す
 単純に「相手先の選択」ってタイトルのタイトルバーを持つアプリケーションウィンドウがありませんでした
 ...って場合にもこのエラーが出ますからね。

 タイトルが正確ではないだけなのかも知れません。

（白茶） 2023/09/01(金) 10:47:28

白茶さん

返信ありがとうございます

https://d.kuku.lu/pee65y6cp

画像を見てもらえばわかると思うのですが、タイトルバーに表示されているのは「相手先の選択」ですよね・・・？

私の理解度では何が違うのかわかりませんでした

もう少し試行錯誤してみます

（別アプリ操作） 2023/09/01(金) 15:18:42

もし、エラー箇所までわかっているのなら（わかっているなら言ってください）、
AppActivateだけのプログラムを作ってうまくいくかどうかを確認してみてはどうでしょうか？

それでうまく行かないのであれば、他の部分はどうでも良い話であって、
他の人がどこがエラーがあるのだろうか？とか考える必要もないですよね。

さて、AppActivateはタスクIDでも呼び出せるらしいので、
うまくいかないならそちらも試してみてはどうでしょうか？

参考
http://officetanaka.net/excel/vba/statement/AppActivate.htm

（ゆたか） 2023/09/01(金) 16:17:03

ところで、そのコードってそのまま走らせていますか？

マイクロソフトのサンプルでは

AppActivate "Microsoft Word" ' Activate Microsoft

とあり、文字列の両側に（）もないですし、[True]の両側に[]があって良いとも思えないのですが。

＃　わたしは詳しくないので、間違ってたらご容赦を
（ゆたか） 2023/09/01(金) 16:26:54

 >タイトルバーに表示されているのは「相手先の選択」ですよね・・・？
 そうですね。^^;

 実際に[SHARP MX-3650FN FAX]ドライバをインストールして確認してみましたが
 タイトルは確かに合ってました。

 「相手先の選択」画面が出現する前にAppActivateしてしまってるだけなのかも知れません。
 適当に待ち時間を入れてあげるとか・・・?

    Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

    Sub test()
        ActiveSheet.PrintOut
        ActiveSheet.Range("D2").Copy

        Sleep 250
        AppActivate "相手先の選択", True

        SendKeys "{TAB}"
        SendKeys "{TAB}"
        SendKeys "^v", True '貼り付け Ctrl + V
        SendKeys "{ENTER}" '次へ
        SendKeys "{ENTER}" '次へ
        SendKeys "{ENTER}" '完了(送信する)
    End Sub

 あるいはエラーが出なくなるまでエラー無視でループするとか・・・?
        Do
            Dim e As Long, t As Long
            Sleep 20
            On Error Resume Next
            AppActivate "相手先の選択", True
            e = Err.Number
            On Error GoTo 0
            t = t + 1
            If t > 10 Then
                Debug.Print "諦めた... orz"
                Exit Sub
            End If
        Loop While e <> 0

 なんか、
 そんな感じの対処でイケそうな気はしますよ。

（白茶） 2023/09/01(金) 16:35:57

ゆたか　さん
返信ありがとうございます
()も[]も不要でした

白茶　さん
返信ありがとうございます
ドライバーのインストールまでしてもらいありがとうございます
タイトルバーは「(半角または全角スペース)相手先の選択(半角または全角スペース)」など
そういうのが付いているのかと思いました
不快な思いをさせて申し訳ありませんでした

 Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)の追加とゆたかさんの指摘の通り()、[]を取ったらうまくいきました

宛先の追加の画面でTABキーをどれだけ押しても、「直接入力」タブと「電話帳から選択」タブの切り替えができないのですが、そういうアプリもあるのでしょうか
（別アプリ操作） 2023/09/02(土) 15:01:10

＞タブの切り替えができないのですが
取説はどうなっていますか。
（まま） 2023/09/02(土) 15:17:22

 >不快な思いをさせて申し訳ありませんでした
 いやいや、気になさらないで下さい。^^;
 別に何も不快は感じておりません。

 >TABキーをどれだけ押しても、「直接入力」タブと「電話帳から選択」タブの切り替えができない
 私が入れたドライバの画面だと、
 左下にある[ジョブを設定する(&J)]チェックボックスの次が
 「直接入力」タブまたは「電話帳から選択」タブのオーダーの様です。

 {Alt}押しながらJを2回押して[ジョブを設定する(&J)]に移動し、
 {TAB}押して「直接入力」タブへフォーカス移動
 {→}押せば「電話帳から選択」が表示されました。
 (SendKeysで上手くイケるかな...? ちょっとしんどいですかね ^^;)

 >そういうアプリもあるのでしょうか

   あ り ま す よ ー

 不親切な作り込みのフォームって結構あります。
 例えば
 日●システ●ズの世界的に有名でメチャクチャ高価なジョブ管理システムとか画面最悪です。
 アクセスキーはおろか、タブストップすら付いてないプロパティ画面のオンパレードです。
 マウス無かったら確実に詰みます。
 サーバー上でジョブを管理するシステムがそんな事で良いのか? って感じです。
 (何でそのクオリティでその値段が付けられるのか... コワいわ)

（白茶） 2023/09/02(土) 15:29:19

Option Explicit
Sub SetCB(str As String) 'クリップボードに文字列を格納

  With CreateObject("Forms.TextBox.1")
    .MultiLine = True
    .Text = str
    .SelStart = 0
    .SelLength = .TextLength
    .Copy
  End With
End Sub

Public Function SendKeys(InpKeys As String, Optional Wait As Boolean = False)

    Static WSH As Object
    If WSH Is Nothing Then
        Set WSH = CreateObject("WScript.Shell")
    End If
    WSH.SendKeys InpKeys
End Function

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

Sub FAX宛先入力()

'FAX番号のコピー

Call SetCB(Range("D2").Value)

Sleep 1000

AppActivate "相手先の選択", True 'PC-FAX画面を最前面に呼び出す

'各キーを押していく

SendKeys "%(J)" 'Alt押しながらJ

Sleep 1000

SendKeys "%(J)" 'Alt押しながらJ

Sleep 1000

SendKeys "{RIGHT}" '→キー

Sleep 1000

SendKeys "{LEFT}" '←キー

Sleep 1000

SendKeys "%(M)" 'Alt押しながらM

Sleep 1000

SendKeys "{TAB}"

Sleep 1000

SendKeys "{TAB}"

Sleep 1000

SendKeys "^v", True '貼り付け Ctrl + V

Sleep 1000

SendKeys "{ENTER}" '次へ

Sleep 1000

SendKeys "{ENTER}" '次へ

Sleep 1000

'SendKeys "{ENTER}" '完了(送信する)

End Sub

Option Explicit

Sub FAX自動送信用()

Dim shW As Worksheet
Dim c As Range
Dim i As Long

'使用するプリンタを一時的に切り替える
'正式名称、ポート番号が必要

'win + R regedit
'HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices

'プリンタ名とポートが表示される

Application.ActivePrinter = "SHARP MX-3650FN FAX on Ne02:"

'MsgBox "一時的に切り替えたプリンタは「" & Application.ActivePrinter & "」"

Application.ScreenUpdating = False
Set shW = Sheets("作業_FAX") '作業用シート
shW.Cells.ClearContents '作業シートのクリア

With Sheets("見積依頼") 'データ元シート

    'D列のメーカー名の重複を排除して作業シートに抽出
    '.Columns("A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("作業_FAX").Range("A1"), Unique:=True
    Sheets("見積依頼").Range("D12:D162").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Sheets("作業_FAX").Range("A1"), Unique:=True

    'オートフィルター設定があればいったん解除
    If .AutoFilterMode Then .AutoFilter.Range.AutoFilter
    'あらためてオートフィルター設定
    .Range("D12").AutoFilter

    'ユニークになったメーカー名リストからメーカー名を１つずつ抽出
    For Each c In shW.Range("A2", shW.Range("A" & shW.Rows.Count).End(xlUp))

        For i = 2 To 6
            '抽出した品番の値でフィルタリングして印刷
            .AutoFilter.Range.AutoFilter Field:=4, Criteria1:=c.Value

            .Range("A2") = .Cells(i, 14)

                If .Range("A2") = 0 Then GoTo BreakLabel 'A2がゼロの時BreakLabelまで処理が飛ぶ

                .PrintOut '印刷
                '.PrintPreview 'テスト用印刷プレビュー

                Call FAX宛先入力

        Next i
BreakLabel:
    Next

    'オートフィルター解除
    .AutoFilter.Range.AutoFilter
End With

shW.Cells.ClearContents '作業シートのクリア
Application.ScreenUpdating = True
'MsgBox "印刷終了"

Sheet2.Range("D12").AutoFilter 4, "<>" '見積依頼 D12へフィルター設定空白を除外

MsgBox "印刷マクロ終了"

End Sub

色々試していて返事が遅くなりました。

上記マクロでやりたいことができるようになりました。
D2の値は数式で表示していたので、私の提示したマクロではうまくいっていないようでした。

参考にしたページ
https://teratail.com/questions/197579

返信を付けてくれた皆さんのおかげです。
ありがとうございました。

PCFAX自動化
（別アプリ操作） 2023/09/21(木) 17:17:44

コメント返信：

[ 一覧(最新更新順) ]

[[20230831190035]] 『VBAから別ソフトの操作』（別アプリ操作） ページの最後に飛ぶ

[[20230831190035]]　『VBAから別ソフトの操作』（別アプリ操作）　ページの最後に飛ぶ