| 投稿日 | ： 2005/03/23(Wed) 18:34 |
| 投稿者 | ： ゆりか |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^6: WebBrowser での Excel 制御について |
何度もお答え頂き、ありがとうどざいます。
> 表示だけなら Spreadsheet1 ではどうですか？
実は Spreadsheet も試してました。^^;
ですが、Excelファイルの情報の取得方法がわからなくてあっさりと諦めてました。
xlSheet.UsedRange.Copy
こう言う方法があったんですね。
そしてこの方法で作ってみました。
Spreadsheet のポップアップメニューを完全に非表示にすることが出来なかった事と
起動時に少々時間が掛かるかなとは思いましたが理想的なものが出来たように思います。
念のため、以下にコード表記します。
今回、いろいろと教えて頂きましてありがとうございました。
今後またお世話になることもあるかと思いますがそのときはよろしくお願い致します。
Option Explicit
Private m_xlApp As Excel.Application
Private WithEvents m_xlBook As Excel.Workbook
Private m_xlSheet As Excel.Worksheet
Private Sub Form_Load()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strAddress As String
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Temp\Book1.xls")
Set xlSheet = xlBook.Worksheets(1)
strAddress = xlSheet.UsedRange.Address(False, False, xlA1)
xlSheet.UsedRange.Copy
Spreadsheet1.DisplayToolbar = False 'ツールバーを非表示にする
Spreadsheet1.DisplayTitleBar = False 'タイトル バーを非表示にする
Spreadsheet1.AllowPropertyToolbox = False '実行時にプロパティ ツールボックスを無効にする
Spreadsheet1.Range(strAddress).Paste
Spreadsheet1.ActiveSheet.Protection.Enabled = True 'シートを保護する
Spreadsheet1.Range("A1").Select
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Private Sub Command1_Click()
Const ERR_APP_NOTRUNNING As Long = 429
On Error Resume Next
'Excel の現在のインスタンスを開きます。
Set m_xlApp = GetObject(, "Excel.Application")
'Excel が起動されていないと、エラーが発生
If Err.Number = ERR_APP_NOTRUNNING Then
Set m_xlApp = CreateObject("Excel.Application")
ElseIf Err.Number <> 0 Then
GoTo XlsNew_ERR
End If
Set m_xlSheet = Nothing
Set m_xlBook = Nothing
'エラーが発生した場合は Err オブジェクトをクリア
Err.Clear
On Error GoTo XlsNew_ERR
'指定したExcelファイルを開く
Set m_xlBook = m_xlApp.Workbooks.Open("C:\Temp\Book1.xls")
'シート№の指定
Set m_xlSheet = m_xlBook.Worksheets(1)
'マクロの警告やメッセージを表示しないように設定（参考）
'm_xlApp.DisplayAlerts = False
' Excelの表示有無
m_xlApp.Visible = True
m_xlApp.Windows(1).Visible = True
Exit Sub
XlsNew_ERR:
' エラーメッセージを表示
MsgBox Err.Description
End Sub
Private Sub m_xlBook_BeforeClose(Cancel As Boolean)
'機能 ：ブックを閉じる前に発生します。
' ブックが変更された場合、ユーザーに変更内容の保存を要求する前に、このイベントが発生
'ブックが変更されたときは必ずその内容を保存する
If m_xlBook.Saved = False Then
'保存
m_xlBook.Save
Spreadsheet1.ActiveSheet.Protection.Enabled = False 'シート保護を解除する
strAddress = xlSheet.UsedRange.Address(False, False, xlA1)
m_xlSheet.UsedRange.Copy
Spreadsheet1.Range(strAddress).Paste
Spreadsheet1.ActiveSheet.Protection.Enabled = True 'シートを保護する
Spreadsheet1.Range("A1").Select
End If
m_xlBook.Close
End Sub
Private Sub m_xlBook_Deactivate()
'機能 ：グラフまたはブックが非アクティブになったときに発生
' Excelの表示有無
m_xlApp.Visible = False
m_xlApp.Windows(1).Visible = False
End Sub
Private Sub Spreadsheet1_BeforeCommand(ByVal EventInfo As OWC.SpreadsheetEventInfo)
If EventInfo.Command = ssCopy Then
MsgBox "このワークシートはコピーできません"
EventInfo.ReturnValue = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
' Excelの終了
m_xlApp.Quit
Set m_xlSheet = Nothing
Set m_xlBook = Nothing
Set m_xlApp = Nothing
End Sub