ShellでEXCEL2002を起動する方法について

質問

• VB6のコーディングで、Shell関数を使用してEXCEL2002を起動する方法について、正常な表示と動作をする方法を教えてください。
• EXCEL2002では、Shell関数を使用してEXCELを起動すると、表示方法が他のバージョンと異なります。最後に使用した大きさやロゴマークが表示されてしまう問題があります。
• この問題を解決し、VB6のコーディングでEXCEL2002を起動してマクロを使用した帳票を出力する方法を教えてください。

回答No.4

TAGOSAKU7

そーですかー。Shellのオプションを受け入れてくれませんかー。。。

おそらく、Windowsから送られてくるメッセージをSpyで見てみたら、正確な方法がわかるのでしょうが・・・環境がないと実験ができないので、原因追求をしたくてもできないのです。。。

なので、こちらの方でも唯一可能な方法で作成しました。
もろ反則技です。

処理内容
１．ピクチャボックスを創生
２．ピクチャボックスの親ハンドルをデスクトップに変更
３．ピクチャボックスのサイズを画面サイズに変更し、最前面固定
４．デスクトップの状態をピクチャボックスに描画
５．ピクチャボックスを表示
６．エクセルを起動
７．エクセルを最小化
８．ピクチャボックスの破棄

ねっ反則でしょ？（笑）

関数creDmyPicで１～５の処理を行っています。
関数openExcelで６～７の処理を行っています。

ちなみに・・・
この方法は、どうしても見せたくない処理があるけど、いちいち制御するのが面倒な時に使ってます。

これがダメなら・・・すいません・・・回答不能です。。。

Option Explicit
Private Const HWND_TOPMOST = (-1)
Private Type RECT
　　Left As Long
　　Top As Long
　　Right As Long
　　Bottom As Long
End Type

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Command1_Click()
　　Dim dmyPic　As PictureBox

　　'ピクチャボックスを作成して、一時画面描画を視覚的にとまったように見せる
　　Set dmyPic = creDmyPic("picDammy")
　　If dmyPic Is Nothing Then
　　　　Call MsgBox("ダミー作成失敗")
　　End If

　　'エクセルブックのオープン
　　Call openExcel("c:\test.xls")

　　'アクティブウィンドウを自分自身に設定
　　Call SetForegroundWindow(Me.hwnd)

　　'ピクチャボックスウィンドウの破棄
　　Controls.Remove dmyPic
End Sub

'【機　能】エクセルを最小化で起動する
'【引　数】エクセルブックのフルパス
'【注意点】エラーチェックを使用してない
Private Sub openExcel(inOpenXlsBookPath As String)
　　Dim xlApp　 As Excel.Application

　　'エクセル起動
　　Call Shell("C:\Program Files\Microsoft Office\Office\EXCEL.exe /e")
　　Set xlApp = GetObject("", "Excel.Application")

　　'エクセル最小化
　　xlApp.WindowState = xlMinimized

　　'ワークブックオープン
　　xlApp.Workbooks.Open inOpenXlsBookPath

　　'開放
　　xlApp.Visible = True
　　Set xlApp = Nothing
End Sub

'【機　能】ピクチャボックスを創生して、現在のデスクトップ状態を描画し、最前面で表示を行う
'【引　数】創生するピクチャボックスの名称（任意）
'【注意点】パラメータには既存のピクチャボックスと重複しない名称を使用すること
Private Function creDmyPic(inPicBoxName As String) As PictureBox
　　Dim picWork　　　　 As PictureBox　 'ピクチャボックスオブジェクト
　　Dim lngDeskTopWnd　 As Long　　　　 'ハンドル(デスクトップ)
　　Dim rcDeskTop　　　 As RECT　　　　 '領域座標(デスクトップ)
　　Dim lngDeskTopDC　　As Long　　　　 'デバイスコンテキスト(デスクトップ)

　　'左位置/上位置/幅/高
　　Dim lngL As Long, lngT As Long, lngW As Long, lngH As Long

　　'失敗したら終了
　　On Error GoTo PGMEND

　　'ピクチャボックスを作成
　　Set picWork = Controls.Add("VB.PictureBox", inPicBoxName)

　　'ピクチャボックスの初期設定
　　With picWork
　　　　.Appearance = 0
　　　　.AutoRedraw = True
　　　　.AutoSize = False
　　　　.BorderStyle = 0
　　End With

　　'デスクトップのハンドルを取得
　　lngDeskTopWnd = GetDesktopWindow
　　'デスクトップ領域の座標を取得
　　Call GetWindowRect(lngDeskTopWnd, rcDeskTop)
　　'デスクトップのデバイスコンテキストを取得
　　lngDeskTopDC = GetDC(lngDeskTopWnd)

　　'左位置/上位置/幅/高を取得
　　With rcDeskTop
　　　　lngL = .Left: lngT = .Top: lngW = .Right - .Left: lngH = .Bottom - .Top
　　End With

　　With picWork
　　　　'親ハンドルの変更（ピクチャボックスをフォームから飛び出させる）
　　　　Call SetParent(.hwnd, lngDeskTopWnd)

　　　　'デスクトップの領域にピクチャボックスのサイズをあわし、画面Zオーダーを最前面固定にする
　　　　Debug.Print SetWindowPos(.hwnd, HWND_TOPMOST, lngL, lngT, lngW, lngH, 0)

　　　　'描画実行
　　　　Call StretchBlt(.hdc, lngL, lngT, lngW, lngH, lngDeskTopDC, lngL, lngT, lngW, lngH, vbSrcCopy)

　　　　'ピクチャボックスの表示
　　　　.Visible = True
　　End With

　　'ピクチャボックスオブジェクトを返す
　　Set creDmyPic = picWork
PGMEND:
End Function