tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトル空白ダイアログに名前を入力する
記事No15364
投稿日: 2011/11/25(Fri) 08:13
投稿者kiyo
こんにちは
AutoCADを使用しています。
独自でAutoCADの図面をPDFを作成したいのですが、やり方がわかりません。
PDFに変換するソフトは、「CutePDF」です。
AutoCADで一連の印刷までは、出きるのですが
最後に「CutePDF」から「名前を付けて保存」のダイアログを出してきます。
そこのファイル名が空白のままなのです。(バグです)
本当なら自動入力しているはずですが、
なぜか会社のPCだけ自動入力をしません。
当社は、セキュリティ上非常に厳しくて管理者権限がないと、
簡単なソフトもインストール出来ない様になっています。
唯一標準で許されているのが「CutePDF」なのです。
Verを上げれば治ると思いますが、稟議書が必要で何ヶ月もかかります。
また一個人のわがままでは稟議も通りません。
自分で工夫するしかないのです。

VB6で自作の連続印刷は、作ったのですが今度は連続PDF印刷を作成したいと思いました。
やりたい事
・現在開いているAutoCADの図面名を取得(拡張抜き):例 01F-H01.dwg→01F-H01
・取得した図面名を「CutePDF」の「名前を付けて保存」のダイアログ空白部に送る。
・最後に「保存」をVB6にさせる。
以上です。
可能でしょうか?
宜しく、お願いいたします。

[ツリー表示へ]
タイトルRe: 空白ダイアログに名前を入力する
記事No15365
投稿日: 2011/11/25(Fri) 15:14
投稿者YK
こんにちは
> AutoCADを使用しています。
> 独自でAutoCADの図面をPDFを作成したいのですが、やり方がわかりません。
> PDFに変換するソフトは、「CutePDF」です。
> ・現在開いているAutoCADの図面名を取得(拡張抜き):例 01F-H01.dwg→01F-H01
> ・取得した図面名を「CutePDF」の「名前を付けて保存」のダイアログ空白部に送る。
> ・最後に「保存」をVB6にさせる。

APIだらけになると思いますが出来ると思いますよ。
図面番号は GetWindowText で取れます。
後、
ページ設定画面でプロッタの名前を「CutePDF」に変更をして、
印刷画面でOKで
CutePDFの保存画面が出るので
WM_SETTEXTで図面番号を送ってあげれば出来そうです。
ページ設定や印刷の画面は
GetMenuでMenuIDを取得して WM_Commandで開けそうです。
時間が空いたら挑戦してみます。



 

[ツリー表示へ]
タイトルRe^2: 空白ダイアログに名前を入力する
記事No15369
投稿日: 2011/11/30(Wed) 14:11
投稿者kiyo
YK様 有難うございます。
> APIだらけになると思いますが出来ると思いますよ。
> 図面番号は GetWindowText で取れます。
> 後、
> ページ設定画面でプロッタの名前を「CutePDF」に変更をして、
> 印刷画面でOKで
> CutePDFの保存画面が出るので
> WM_SETTEXTで図面番号を送ってあげれば出来そうです。
すごく、難しそうですね。私にはさっぱりです。
印刷等の設定は、AutoLISPを読み込ませていますので不要です。
-----AutoLISPの読み込み
Set acaddoc = acadapp.Documents.Open(importfile)
              acaddoc.SendCommand "(" & "load" & """itoki-pdf-plot.lsp""" & ")" & vbCr
              acaddoc.SendCommand "pdf-plot" & vbCr
ここまでは、印刷ゲージが出て印刷していますがこの後に「CutePDF」から「名前を付けて保存」画面が出てきます。
正常であればここでファイル名が自動入力され「Enter」を押して終わりですが、
会社PCだとなぜか「空白」なのです。原因はわかりません。
自宅のPCで試した所、ちゃんと自動入力されて「Enter」で終了です。
Sleep (2000)
SendKeys "{Enter}", True
すこし間を置き、sendkeys で「Enter」で出来ました。
会社PCが正常に動けばこんな苦労はしなくて済んだのです。
YK様
何とぞ、VBで処理できる様にお願いいたします。

[ツリー表示へ]
タイトルRe^3: 空白ダイアログに名前を入力する
記事No15370
投稿日: 2011/12/01(Thu) 09:22
投稿者YK
こんにちは。
Acadのバージョン: 2002
OS              :  XP SP3
VB6             :  SP6        

> 印刷等の設定は、AutoLISPを読み込ませていますので不要です。
> -----AutoLISPの読み込み
> Set acaddoc = acadapp.Documents.Open(importfile)
>               acaddoc.SendCommand "(" & "load" & """itoki-pdf-plot.lsp""" & ")" & vbCr
>               acaddoc.SendCommand "pdf-plot" & vbCr
> ここまでは、印刷ゲージが出て印刷していますがこの後に「CutePDF」から「名前を付けて保存」画面が出てきます。

ここでページ設定画面で印刷ボタンを押しているから名前を付けて保存画面がでます。
一旦この画面を OK ボタンで終了させてから
印刷画面の OK ボタンを押した時にどうなるか試してみてください。
よかったらAutoLispを書き換える。
駄目だったらどの時点でVBに処理を渡すのか教えてください。

それと
> Sleep (2000)
> SendKeys "{Enter}", True
はどこで処理を行っているのでしょうか?

[ツリー表示へ]
タイトルRe^4: 空白ダイアログに名前を入力する
記事No15371
投稿日: 2011/12/01(Thu) 13:27
投稿者kiyo
お世話になります。
こんな感じです。
  '******* PDFファイル印刷
     If Check2.Value = 1 Then
        '印刷部数を繰り返す
        For k = 1 To Val(Text0.Text)
        'リスト内のDWGファイルの数
         i = DwgList.listcount
         'リストの数だけ繰り返し
          For j = 0 To i - 1
         'DWGファイル名
          importfile = DwgList.List(j)
         'リストボックスの図面をオープン
         Set acaddoc = acadapp.Documents.Open(importfile)
         acaddoc.SendCommand "(" & "load" & """itoki-pdf-plot.lsp"""& ")" & vbCr
         acaddoc.SendCommand "pdf-plot" & vbCr
---→ここでpdf-plotコマンドが走って、印刷ゲージが終了。この後「CutePDF」
      からの「名前を付けて保存」画面がでます。
      
       この間に問題の処理構文が入るかと思います。
            
                   Sleep (2000)
                   SendKeys "{Enter}", True
                   'ファイルを閉じる,図面を変更保存しないで終了
                   acaddoc.Close (False)
               Next j
        Next k
     End If
-----------
こんな感じです。宜しくお願いいたします。

[ツリー表示へ]
タイトルRe^5: 空白ダイアログに名前を入力する
記事No15373
投稿日: 2011/12/01(Thu) 16:13
投稿者YK
こんにちは。
一応フォームのコマンドボタンから実行するものとして

標準モジュールに
Option Explicit
Private Declare Function FindWindow Lib "user32" _
                         Alias "FindWindowA" _
                        (ByVal lpClassName As String, _
                         ByVal lpWindowName As String) As Long
        
Private Const WM_COMMAND = &H111
Private Const WM_CLOSE = &H10

Private Declare Function PostMessage Lib "user32" _
                         Alias "PostMessageA" _
                        (ByVal hwnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, ByVal lParam As Long) As Long
        
Private Declare Function GetDlgItem Lib "user32" _
                        (ByVal hDlg As Long, _
                         ByVal nIDDlgItem As Long) As Long
        
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Private Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageA" _
                        (ByVal hwnd As Long, _
                         ByVal Msg As Long, _
                         ByVal wParam As Long, _
                         lParam As Any) As Long
                        
Private Const CB_ADDSTRING = &H143
Private Const CB_SETCURSEL = &H14E
Private Const CB_GETCOUNT = &H146
Private Const CB_GETCURSEL = &H147
Private Const CB_GETLBTEXT = &H148
Private Const CB_GETLBTEXTLEN = &H149
Private Const CB_GETITEMDATA = &H150
Private Const CB_RESETCONTENT = &H14B

Private Declare Function GetDlgCtrlID Lib "user32" _
                        (ByVal hwnd As Long) 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

Public Declare Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long

Private Declare Function IsWindowVisible Lib "user32" _
                        (ByVal hwnd As Long) As Long

Private Declare Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hwnd As Long, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As Long) 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 GetParent Lib "user32" _
                        (ByVal hwnd As Long) As Long

Private Declare Function GetWindowLong Lib "user32" _
                         Alias "GetWindowLongA" _
                        (ByVal hwnd As Long, _
                         ByVal nIndex As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" _
                         Alias "GetWindowTextLengthA" _
                        (ByVal hwnd As Long) As Long

Private Declare Sub Sleep Lib "kernel32" _
                        (ByVal dwMilliseconds As Long)

Private Const BN_CLICKED = 0
Private Const GW_OWNER = 4
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Const WS_BORDER = &H800000

Public strDwgNo As String
Public aHwnd    As Long

Public Function EnumWindowsProc(ByVal hwnd As Long, _
                         lParam As Long) As Long
    
    Dim strClassBuff    As String * 128
    Dim strDwgNoBuff    As String * 516
    Dim lngRtn          As Long
    Dim lngThreadId     As Long
    Dim lngProcesID     As Long
    Dim lngStyle        As Long

    If IsWindowVisible(hwnd) = 0 Then GoTo EnumPass
    If GetParent(hwnd) <> 0 Then GoTo EnumPass
    If GetWindowTextLength(hwnd) = 0 Then GoTo EnumPass
    lngStyle = GetWindowLong(hwnd, GWL_STYLE)
    If Not lngStyle And WS_SYSMENU Then GoTo EnumPass
    If Not lngStyle And WS_BORDER Then GoTo EnumPass
    
    lngRtn = GetWindowText(hwnd, strDwgNoBuff, Len(strDwgNoBuff))
    strDwgNo = Left(strDwgNoBuff, InStr(strDwgNoBuff, vbNullChar) - 1)
    If strDwgNo Like "*AutoCAD*" Then
        aHwnd = hwnd
        Exit Function
    End If
EnumPass:
    EnumWindowsProc = True
End Function

Public Sub CutePDFPrintSet()
    Dim lngRtn  As Long
    Dim hDlg    As Long
    Dim hPro    As Long
    Dim hOK     As Long
    Dim t
    
    t = Timer
'   此処から CutePDF のダイアログ作成待ち
    Do
        Sleep 1
        hDlg = FindWindow("#32770", "名前を付けて保存")
        If hDlg Then Exit Do
        If Timer > t + 10 Then      ' Time Over Check
            MsgBox "CutePDF の名前を付けて保存がありません。"
            Exit Sub
        End If
    Loop
    ' 図面番号
    hPro = GetDlgItem(hDlg, &H480)  '名前のWindowHandle
    Sleep 700
    DoEvents
    ' 図面番号のSET
    lngRtn = SendMessage(hPro, WM_SETTEXT, 0, ByVal strDwgNo)
    DoEvents
    ' 保存ボタンを押す
    hOK = GetDlgItem(hDlg, &H1)     '保存
' ↓行のコメントを外すと"名前を付けて保存"の内容が確認できます。
'    Exit Sub
    
    lngRtn = PostMessage(hDlg, WM_COMMAND, MAKEWPARAM(GetDlgCtrlID(hOK), BN_CLICKED), hOK)
    DoEvents
    Sleep 500
' 上書きになった場合
    hDlg = FindWindow("#32770", "名前を付けて保存")
    If hDlg = 0 Then Exit Sub
'    ' 上書きの場合
    hOK = GetDlgItem(hDlg, &H6)     'YES
    lngRtn = PostMessage(hDlg, WM_COMMAND, MAKEWPARAM(GetDlgCtrlID(hOK), BN_CLICKED), hOK)
End Sub

Private Function MAKEWPARAM(LOWWORD As Long, HIWORD As Long) As Long
    MAKEWPARAM = (LOWWORD And &HFFFF&) Or (HIWORD * &H10000)
End Function

フォームモジュールに
Option Explicit

Private Sub Command1_Click()
    Dim lngRtn  As Long
    ' WindowTextから図面番号
    lngRtn = EnumWindows(AddressOf EnumWindowsProc, 0&)
    If aHwnd = 0 Then
        MsgBox "Auto Cad が立ち上がっていません。"
        Exit Sub
    End If
    strDwgNo = Split(Split(strDwgNo, "[")(1), "]")(0)
    ' ↓図面番号
    strDwgNo = Left(strDwgNo, Len(strDwgNo) - (Len(strDwgNo) _
             - InStrRev(strDwgNo, ".")) - 1)

' kiyo さんの処理 を実行して
''************************* PDFファイル印刷 *************************
     If Check2.Value = 1 Then
        '印刷部数を繰り返す
        For k = 1 To Val(Text0.Text)
            'リスト内のDWGファイルの数
             i = DwgList.ListCount
             'リストの数だけ繰り返し
          For j = 0 To i - 1
             'DWGファイル名
              importfile = DwgList.List(j)

       ' 注  
             'もし importfile が 図面番号でしたら
        'strDwgNo = Left(strDwgNo, Len(importfile) - (Len(importfile) _
                  - InStrRev(importfile, ".")) - 1)
             'としましょう。

             'リストボックスの図面をオープン
             Set acaddoc = acadapp.Documents.Open(importfile)
             acaddoc.SendCommand "(" & "load" & """itoki-pdf-plot.lsp""" & ")" & vbCr
             acaddoc.SendCommand "pdf-plot" & vbCr
    ''---→ここでpdf-plotコマンドが走って、印刷ゲージが終了。この後「CutePDF」
    ''      からの「名前を付けて保存」画面がでます。
''************************* PDFファイル印刷 *************************

            ' CutePDFの名前を付けて保存処理
              CutePDFPrintSet
          Next
        Next
    End If
End Sub

[ツリー表示へ]
タイトルRe^6: 空白ダイアログに名前を入力する
記事No15374
投稿日: 2011/12/02(Fri) 17:21
投稿者kiyo
お世話になります。
ものすごい構文ですね。二つの操作にこれだけあるとは......驚きです!
私なんかには到底無理な話でした。

一応、やってみました。ですが
モジュール
Public Declare Function EnumWindows Lib "user32" _
                        (ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long
で「コンパイルエラー」になりました。
さっぱりわかりません。
宜しく、お願いいたします。

[ツリー表示へ]
タイトルRe^7: 空白ダイアログに名前を入力する
記事No15375
投稿日: 2011/12/02(Fri) 18:12
投稿者YK
こんにちは。
>
> 一応、やってみました。ですが
> モジュール
> Public Declare Function EnumWindows Lib "user32" _
>                         (ByVal lpEnumFunc As Long, _
>                          ByVal lParam As Long) As Long

あの〜 標準モジュールに張付けていますか?
標準モジュールと
フォームモジュール
に分けてありますから間違わないようにして下さい。

[ツリー表示へ]
タイトルRe^8: 空白ダイアログに名前を入力する
記事No15382
投稿日: 2011/12/06(Tue) 08:47
投稿者kiyo
お世話になります。
ずっとやっていますが、初心者同然の私には無理です。
どこをどうしたらいいのか全然わかりません。
抜粋でPDFの所だけ載せましたが、このプログラムはリストボックスにドラッグ&ドロップ
でA1からA3のプリンタ・プロッタを複数枚・部数を連続で印刷できる様にしたもので、
中身が結構あります。単純にAutoCAD2009にあるPDF印刷なら問題なく動作していたのですが
AutoCADのPDFは、非常に汚い事がわかったので「CutePDF」に変えようと思ったのですが
なぜか(バグ?)、名前が自動入力できない為にこんなに苦労してます。
YK様にこんなに親切にして頂いたのに.....悔しいです。情けないです。
どうすれば、いいのでしょうか?プログラム自体をどこかにUPした方がいいでしょうか?
そんな、図〃しい事できませんし......(-_-;)
ご助言、お願いいたします。

[ツリー表示へ]
タイトルRe^9: 空白ダイアログに名前を入力する
記事No15383
投稿日: 2011/12/06(Tue) 11:14
投稿者shu
> ずっとやっていますが、初心者同然の私には無理です。
無理ですって言ったらそれで終わりだと思います。初心者って言えば仕事を
しなくていいわけではないです。


> どうすれば、いいのでしょうか?プログラム自体をどこかにUPした方がいいでしょうか?
> そんな、図〃しい事できませんし......(-_-;)
逆に書いたソースをまるっきり載せないで話をしても進まないと思います。
全部載せられたら読む気は起こらないでしょうが必要な部分を載せることは問題解決への助けとなると思います。

[ツリー表示へ]
タイトルRe^9: 空白ダイアログに名前を入力する
記事No15384
投稿日: 2011/12/06(Tue) 11:19
投稿者YK
こんにちは。
失礼なことをお聞きしますが
標準モジュールとフォームモジュールの違いくらい分かりますよね。
前記UPしたコードに標準モジュールにと書いてあるコードを
標準モジュールにコピペして
フォームモジュールにと書いてあるコードを
フォームモジュールにコピペして下さい。
フォームモジュールのCommand1という名前のコマンドボタンを張付けて
その中にkiyoさんが実行するコードをコーディングしているものとします。

'***********************
もし、うまく動かなかったらAutoCadでCutePDFの名前を付けて保存のダイアログを
だしておいて
CutePDFPrintSetを実行してみてください。
新しいProjectで
フォームモジュールにCommand1という名前のコマンドボタンを張付けて実行
Private Sub Command1_Click()
    CutePDFPrintSet
End Sub
当然標準モジュールも前記の通りコピペして下さい。

[ツリー表示へ]
タイトルRe^10: 空白ダイアログに名前を入力する
記事No15385
投稿日: 2011/12/06(Tue) 11:53
投稿者kiyo
お世話になります。
> 標準モジュールとフォームモジュールの違いくらい分かりますよね。
正直、よくわかっていません。今使っているVBプログラムも、もともとあったプログラムを
改変してつくりました。後は本を読んだり、WEBで参考を見たりして.....
動作してるのが不思議なくらいです。お恥ずかしい(-_-;)
text形式ですが、ソースをUPします。
YK様には、失礼と思いますが一度中身を見てください。(恥ずかしいですけど)
もし、その気がなかったら無視してください。
URLです。
http://firestorage.jp/download/b622baa5aa508c5dec7adaf10777f0801f07755b
(URLがはじかれるので「h」抜きました)
本当にお世話を掛けてすみません<(_ _)>

[ツリー表示へ]
タイトルRe^11: 空白ダイアログに名前を入力する
記事No15386
投稿日: 2011/12/06(Tue) 13:48
投稿者YK
こんにちは。
今書いているところはフォームモジュールです。
メニューのプロジェクト => 標準モジュールの追加=>クリック
標準モジュールをWクリックで標準モジュールが追加されます。
それで前記に申し上げたことをTESTしてみて下さい。
TESTしてみたいのでお願いできたら下記のファイルの内容をUPしてみて下さい。
pdf-plot.lsp
pdf-plot

[ツリー表示へ]
タイトルRe^12: 空白ダイアログに名前を入力する
記事No15387
投稿日: 2011/12/06(Tue) 14:49
投稿者kiyo
お世話になります。
テストして下さるんですか!有り難いです!
URL
http://firestorage.jp/download/e6edc0fc434067366586e20d2161df3a8e164e91
宜しく、お願いいたします。

[ツリー表示へ]
タイトルRe^13: 空白ダイアログに名前を入力する
記事No15390
投稿日: 2011/12/07(Wed) 10:12
投稿者YK
こんにちは。
下記の方法で出来ました。
必要なところしかUPしませんので後は付け加えて下さい。

***********    此処からフォームモジュールに       ************
***********    送って頂いた コードの一部分変更   ************
***********    その他変更無し                     ************

Private Sub Command1_Click()
    Dim importfile As String
    Dim i As Integer, j As Integer, k As Integer
    Dim strDwgNo    As String
    
    On Error Resume Next
    'AutoCADアプリケーションオブジェクトを取得
    Set acadapp = GetObject(, "AutoCAD.Application")
    'AutoCADアプリケーションオブジェクト取得に失敗した時
    If Err Then
        'AutoCAD 2009を起動
        Set acadapp = CreateObject("AutoCAD.Application")
     'エラーオブジェクトをクリア
        Err.Clear
    End If
    'AutoCADを表示
     acadapp.Visible = True
      'Acad2009を最大化
     acadapp.WindowState = AcWindowState.acMax
     'アプリを最小化
     WindowState = 1
    
    '******* その他印刷 ********
        ' 省略
    '******* PDFファイル印刷 ********
    If Check2.Value = 1 Then
        '印刷部数を繰り返す
        For k = 1 To Val(Text0.Text)
           'リスト内のDWGファイルの数
            i = DwgList.ListCount
                'リストの数だけ繰り返し
                For j = 0 To i - 1
                    'DWGファイル名
                    importfile = DwgList.List(j)

        ' ****   変更部分 ↓ ************
                       ' ↓図面番号
                    strDwgNo = Dir(importfile)
                    If strDwgNo <> "" Then
                        strDwgNo = Left(strDwgNo, Len(strDwgNo) - (Len(strDwgNo) _
                                 - InStrRev(strDwgNo, ".")) - 1)
        ' ****   変更部分 此処まで ↑ ************

                       'リストボックスの図面をオープン
                        Set acaddoc = acadapp.Documents.Open(importfile)
                        acaddoc.SendCommand "(" & "load" & """D:/Acad/PDF-PLOT2.lsp""" & ")" & vbCr
                        acaddoc.SendCommand "pdf-plot" & vbCr
                    
       ' ****   変更部分 ↓ ************
                     ' 此処で ↓ で名前を付けて保存処理
                        Call CutePDFPrintSet(strDwgNo)
        ' ****   変更部分 此処まで ↑ ************

                        'ファイルを閉じる,図面を変更保存しないで終了
                        acaddoc.Close (False)
                    End If
               Next j
        Next k
    End If
    '******* その他印刷 ********
        ' 省略
    '******* その他印刷 ********
        
        'ACAD終了
         'acadapp.Quit
         SendKeys "%{F4}", True
         AppActivate "AutoCAD 2009"
         Sleep (1000)
         SendKeys "{Esc} {Esc}", True
        '変換終了のメッセージを表示
        '65584=65536(メッセージボックスを前面)+48(注意メッセージアイコン)
         MsgBox "印刷終了!", 65584, "End of Plot"
        'アプリの最大化
        WindowState = 0
End Sub
' その他コードは省いてあります。
***********    フォームモジュールは此処まで   ****************


***********    此処から標準モジュールに   ********************
***********    標準モジュールの追加方法は前記述を参照 ********
Option Explicit
Private Declare Function FindWindow Lib "user32" _
                         Alias "FindWindowA" _
                        (ByVal lpClassName As String, _
                         ByVal lpWindowName As String) As Long

Private Const WM_COMMAND = &H111
Private Const WM_CLOSE = &H10
Private Const BN_CLICKED = 0

Private Declare Function PostMessage Lib "user32" _
                         Alias "PostMessageA" _
                        (ByVal hWnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetDlgItem Lib "user32" _
                        (ByVal hDlg As Long, _
                         ByVal nIDDlgItem As Long) As Long

Private Const WM_SETTEXT = &HC

Private Declare Function Sendmessage Lib "user32" _
                         Alias "SendMessageA" _
                        (ByVal hWnd As Long, _
                         ByVal Msg As Long, _
                         ByVal wParam As Long, _
                         lParam As Any) As Long
                        
Private Declare Function GetDlgCtrlID Lib "user32" _
                        (ByVal hWnd As Long) As Long

Private Declare Sub Sleep Lib "kernel32" _
                        (ByVal dwMilliseconds As Long)

Public Sub CutePDFPrintSet(strDwgNo As String)
    Dim lngRtn  As Long
    Dim hDlg    As Long
    Dim hPro    As Long
    Dim hOK     As Long
    Dim t
    
    t = Timer
'   此処から CutePDF のダイアログ作成待ち
    Do
        Sleep 1
        hDlg = FindWindow("#32770", "名前を付けて保存")
        If hDlg Then Exit Do
        If Timer > t + 10 Then      ' Time Over Check
            MsgBox "CutePDF の名前を付けて保存がありません。"
            Exit Sub
        End If
    Loop
    ' 図面番号
    hPro = GetDlgItem(hDlg, &H480)  '名前のWindowHandle
    Sleep 700
    DoEvents
    ' 図面番号のSET
    lngRtn = Sendmessage(hPro, WM_SETTEXT, 0, ByVal strDwgNo)
    DoEvents
    ' 保存ボタンを押す
    hOK = GetDlgItem(hDlg, &H1)     '保存
' ↓行のコメントを外すと"名前を付けて保存"の内容が確認できます。
'    Exit Sub
    
    lngRtn = PostMessage(hDlg, WM_COMMAND, MAKEWPARAM(GetDlgCtrlID(hOK), BN_CLICKED), hOK)
    DoEvents
    Sleep 500
' 上書きになった場合
    hDlg = FindWindow("#32770", "名前を付けて保存")
    If hDlg = 0 Then Exit Sub
'    ' 上書きの場合
    hOK = GetDlgItem(hDlg, &H6)     'YES
    lngRtn = PostMessage(hDlg, WM_COMMAND, MAKEWPARAM(GetDlgCtrlID(hOK), BN_CLICKED), hOK)
End Sub

Private Function MAKEWPARAM(LOWWORD As Long, HIWORD As Long) As Long
    MAKEWPARAM = (LOWWORD And &HFFFF&) Or (HIWORD * &H10000)
End Function

[ツリー表示へ]
タイトルRe^14: 空白ダイアログに名前を入力する
記事No15404
投稿日: 2011/12/19(Mon) 08:26
投稿者kiyo
YK様 ご無沙汰してます。
返事遅れて申し訳ありません<(_ _)>
結果ですが、出来ました!すごいです!感動!感激です!有難う御座います。
これで煩わしさから解放されます。
私では到底出来なかったと思います。
YK様に、ずっと付き合って頂き誠に感謝しております。
しかし、すごいスキルですね!AutoCADもなさっているみたいだし
何でも出来てすごく羨ましいです。
これからも私なりに勉強して行きたいと思います。
長い間、お付き合い頂き誠に感謝しております<(_ _)>
YK様、これからもがんばってくださいね!
それでは.....

[ツリー表示へ]