[ツリー表示へ] [ワード検索] [Home]
タイトル ： Re^5: 空白ダイアログに名前を入力する 投稿日 ： 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 |
をクリックするとツリー全体を一括表示します） - 空白ダイアログに名前を入力する - kiyo 11/11/25-08:13No.15364