投稿時間:2005/03/23(Wed) 18:34 投稿者名:ゆりか
Eメール:
URL :
タイトル: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") 'シートbフ指定 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
|