[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間:2005/03/18(Fri) 18:16
投稿者名:ゆりか
Eメール:
URL :
タイトル:
WebBrowser での Excel 制御について
はじめまして。ゆりかと申します。
実は、こちらのサイトは日ごろより廻覧させて頂いてました。
書込むのは初めてになります。よろしくお願いします。

早速ですが、今、VBでWebBrowserを使用してExcelとのやり取りをする
アプリを作成しています。
こちらの掲示板や過去一覧を見させて頂き自分なりに構築してみましたが
2つわからない事があります。

【やりたい事】
@WebBrowser上にExcelシートを表示します。
A表示されたExcelシートをExcelで開き、項目等の書込みを行い保存します。
B上記で保存されたExcelシートを再びWebBrowser上に表示します。

※WebBrowser上では表示のみで直接の書込みはさせたくない。
 但し、スクロールは可能にする。
※Excelで書き込みされた内容を「保存しますか?」のメッセージは
 表示させずに保存させたい。
※WebBrowser上でExcelのポップアップメニューは表示させたくない。

以上のことができるように作成してみました。(以下のコード)

【わからない事】
@WebBrowser上で読み取り専用で開くことができない。
 今は、読み取り専用でない為に、Excel上で同じファイルを開くと
 Excelの方で読み取り専用になってしまいます。
 (当たり前といえばそれまでなのですが・・・)
AExcelの「保存しますか?」のメッセージを制御する方法はわかったのですが
 メッセージ無しで保存する方法がみつからないのです。

WebBrowserのヘルプも探しましたが見当たらないと同時にあっても英語であるため
理解できないものもあり、また他サイトも探しましたがこれというヒントも
見つかりませんでした。
どうか、教えて頂けないでしょうか?お願い致します。

【現在のコード】

Option Explicit

Private m_strFileName           As String
Private xlApp                   As Excel.Application
Private xlBook                  As Excel.Workbook
Private WithEvents xlSheet      As Excel.Worksheet

Private Sub Form_Load()
    'ドラッグ&ドロップを禁止
    WebBrowser1.RegisterAsDropTarget = False
    'ファイルの取得
    Call GetFile
End Sub

Private Sub GetFile()
    m_strFileName = "C:\Temp\Book1.xls"
  'Excelファイルの読み込み    
    WebBrowser1.Navigate m_strFileName
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    On Error Resume Next
    Set xlApp = WebBrowser1.Document.Application
    Set xlBook = xlApp.ActiveWorkbook
    Set xlSheet = xlBook.Worksheets(1)
End Sub

Private Sub xlSheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)  
    'ポップアップメニューを制御 [WithEvents]
    Cancel = True
End Sub

Private Sub cmdOpen_Click()
    Dim xlApp         As Excel.Application
    Dim xlBook        As Excel.Workbook
    Dim xlSheet       As Excel.Worksheet
    
    On Error GoTo Xls_ERR
    ' Excelのインスタンス作成
    Set xlApp = CreateObject("Excel.Application")
    ' Excelの表示有無
    xlApp.Visible = True
    ' マクロの警告やメッセージを表示しないように設定
    xlApp.DisplayAlerts = False
    ' 指定したExcelファイルを開く
    Set xlBook = xlApp.Workbooks.Open(m_strFileName)
    'シートbフ指定
    Set xlSheet = xlBook.Worksheets(1)

    ' オブジェクトを解放
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub

Xls_ERR:
    ' エラーメッセージを表示
    MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' オブジェクトを解放
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

【開発環境】
VB6.0 (SP6) /Windows 2000 Pro (SP4) /IE6.0 (SP1) /Excel 2000

投稿時間:2005/03/19(Sat) 14:36
投稿者名:花ちゃん
Eメール:
URL :
タイトル:
Re: WebBrowser での Excel 制御について
> 【わからない事】
> @WebBrowser上で読み取り専用で開くことができない。
>  今は、読み取り専用でない為に、Excel上で同じファイルを開くと
>  Excelの方で読み取り専用になってしまいます。
>  (当たり前といえばそれまでなのですが・・・)
邪道ですが、ファイルを開く前に直接ファイルの属性を変更して置いてから開き
開いた後に元に戻しておけば、一応同条件になるようですが?

又、Excelファイルを表示するだけならMSFlexGridに表示するという手もありますが。

> AExcelの「保存しますか?」のメッセージを制御する方法はわかったのですが
>  メッセージ無しで保存する方法がみつからないのです。
ダイアログボックスは表示してと言う事でしょうか?
でしたら他のファイル保存用ダイアログボックスを使ってファイル名を取得すれば
どうですか?
どうもコードを見ているとExcelファイルを保存・終了するのは手動のようですが
ユーザの操作にまかせるなら手がないかも?

日本語版の[Webrowse.hlp]は「Office 97」のCD-ROMの中に あるようです。

# 丸付き数字は機種依存文字でインターネット上では文字化けする場合があるので
 使用しない方がいいですよ。

投稿時間:2005/03/21(Mon) 14:31
投稿者名:ゆりか
Eメール:
URL :
タイトル:
Re^2: WebBrowser での Excel 制御について
> 又、Excelファイルを表示するだけならMSFlexGridに表示するという手もありますが。
MSFlexGridを使う方法は考えてもみなかったです。
しかし、Excelでデザインされた罫線もMSFlexGridで表示できるのですか?

> ダイアログボックスは表示してと言う事でしょうか?
> でしたら他のファイル保存用ダイアログボックスを使ってファイル名を取得すれば
> どうですか?
> どうもコードを見ているとExcelファイルを保存・終了するのは手動のようですが
> ユーザの操作にまかせるなら手がないかも?
理想は、Book1.xlsにてユーザにデザインさせ、仮で内部的更新をさせてVBアプリ上で表示させる。
最終的に「保存」ボタン等の操作で何らかのファイル名を内部的に付けて更新させる。
という事がしたかったので、ダイアログ表示はさせたくないと思っています。

> 日本語版の[Webrowse.hlp]は「Office 97」のCD-ROMの中に あるようです。
CDを探してみます。

> # 丸付き数字は機種依存文字でインターネット上では文字化けする場合があるので
>  使用しない方がいいですよ。
失礼しました。今後はフォントについても気をつけたいと思います。

とりあえず、邪道といわれる方法とMSFlexGrid、それからヘルプを探して格闘してみます。

・・・ほんとはOLEにてセルヘッダー(と言えばいいのでしょうか?)が表示できれば
いいんですけどねえ。

投稿時間:2005/03/21(Mon) 15:45
投稿者名:花ちゃん
Eメール:
URL :
タイトル:
Re^3: WebBrowser での Excel 制御について
> ・・・ほんとはOLEにてセルヘッダー(と言えばいいのでしょうか?)が表示できれば
> いいんですけどねえ。

WebBrowser 上で Excel のメニューバー等が表示されればいいのでしょうか?
それならできますが。

投稿時間:2005/03/21(Mon) 16:37
投稿者名:ゆりか
Eメール:
URL :
タイトル:
Re^4: WebBrowser での Excel 制御について
何度もお答え、ありがとうございます。

> WebBrowser 上で Excel のメニューバー等が表示されればいいのでしょうか?
> それならできますが。
はい。その方法はわかります。

ずばり、何がしたいかと言えば・・・。
ユーザにある程度の印刷テンプレートを作成させたいと言うのもなんです。
あくまでVBアプリを主とするのですが、
帳票のタイトルや項目、罫線などのデザインをExcelで作成して頂きます。
次に特定のデータベースの項目を選択してどのセルに印刷するかを指定してもらいます。
これで、簡易的な印刷テンプレートの出来上がりです。
あとは、実行ボタンなどでデザインして頂いたExcelシートと印刷位置(セル)、項目を
基に印刷するなりプレビューさせるなりというものです。

今、煮詰まっているのは最初のデザインしたExcelをVBアプリで表示させ
それを基に印刷位置を定義させるということなのです。
Excelを表示させる方法には、最初OLEコントロールを使ってみました。
これだと埋め込み型にするとイメージを取り込めますが、これを保存した後、再びExcelで
表示させる事ができませんでした。
では、リンク型にした場合は・・・。最初の質問にも書きましたが保存ダイアログを消すことが
できませんでした。
そして何よりExcelの列見出し(A,B,Cなど)や行見出し(1,2,3など)が表示できなかったのです。
そこで、いろいろ探したところWebBrowserがあることを知ったのです。
ですが、今度は直接Excelファイルを開くためWebBrowser内で直接書き込めてしまいます。
また、質問通りに別Excelで開くと読み取り専用になってしまいます。
ならばWebBrowserのDocumentを直接表示させればとも考えたのですが、それだと
   WebBrowser1.Document.Application.Visible = True
としてもExcelが起動されるだけでファイルが表示されないのです。

花ちゃんさんがおっしゃって頂いた通りVB上では表示のみでいいんです。
が、セルの位置だけは表示させたくてWebBrowserを選択してしまったのです。
今、CDからヘルプを見てみました。読み取り専用で開くようなプロパティやメソッドは
無いみたいです。
一長一短というか・・・難しいですね。別アプリ(Excel)と連動させるというのは。
  

投稿時間:2005/03/21(Mon) 17:22
投稿者名:花ちゃん
Eメール:
URL :
タイトル:
Re^5: WebBrowser での Excel 制御について
表示だけなら Spreadsheet1 ではどうですか?

[Microsoft Office Web Components 9.0] チェック ボックス、
[Microsoft Office XP Web Components] チェック ボックス、または
[Microsoft Office Web Components 11.0] チェック ボックスをオンにし、
[OK] をクリックします。

Private Sub Command1_Click()
    Dim xlApp   As Excel.Application
    Dim xlBook  As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("C:\Test.xls")
    Set xlSheet = xlBook.Worksheets(1)
    xlSheet.UsedRange.Copy
    Spreadsheet1.DisplayToolbar = False
    Spreadsheet1.DisplayTitleBar = False
    Spreadsheet1.Range("A1").Paste
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub

画面上で編集はできますが元のファイルには何の影響も与えません。

上記実行結果の画面です。
hhttp://bbs4.aimix-z.com/gbbs.cgi?room=hanafusa

投稿時間: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

投稿時間:2005/03/23(Wed) 21:56
投稿者名:ゆりか
Eメール:
URL :
タイトル:
Re^6: WebBrowser での Excel 制御について
すいません。自己レスです。
私の書いたコードだとコンパイル通りません。

Private Sub m_xlBook_BeforeClose(Cancel As Boolean)
    Dim strAddress      As String
    
    'ブックが変更されたときは必ずその内容を保存する
    If m_xlBook.Saved = False Then
        '保存
        m_xlBook.Save
        
        Spreadsheet1.ActiveSheet.Protection.Enabled = False         'シート保護を解除する
        
        strAddress = m_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

が正しいです。失礼しました。