Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6108 / 13646 ツリー ←次へ | 前へ→

【46924】ハイパーリンクでMDBファイル内の指定したテーブルを開きたい susan 07/2/21(水) 23:10 質問[未読]
【46949】Re:ハイパーリンクでMDBファイル内の指定し... Kein 07/2/22(木) 23:01 発言[未読]
【46952】Re:ハイパーリンクでMDBファイル内の指定し... ichinose 07/2/23(金) 7:59 発言[未読]
【47106】Re:ハイパーリンクでMDBファイル内の指定し... susan 07/2/28(水) 23:48 お礼[未読]
【47118】Re:ハイパーリンクでMDBファイル内の指定し... Kein 07/3/1(木) 16:14 回答[未読]
【47133】Re:ハイパーリンクでMDBファイル内の指定し... ichinose 07/3/1(木) 23:11 発言[未読]
【47176】Re:ハイパーリンクでMDBファイル内の指定し... ichinose 07/3/3(土) 7:56 発言[未読]

【46924】ハイパーリンクでMDBファイル内の指定し...
質問  susan  - 07/2/21(水) 23:10 -

引用なし
パスワード
   susanです。

ハイパーリンクについて質問します。

HYPERLINK関数で他のブックの指定したシートを開く方法はわかったのですが
 (例)=HYPERLINK("BOOK1.xls#'Sheet1'!A1","他のブックのシートを開く")

同じような方法でMS-ACCESSのMDBファイル内の指定したテーブルを開くことはできるのでしょうか。

よろしくお願いいたします。

【46949】Re:ハイパーリンクでMDBファイル内の指定...
発言  Kein  - 07/2/22(木) 23:01 -

引用なし
パスワード
   開いて何がしたいのでしょーか ? ただレコードを見るだけなら、いくつかの方法が
考えられますが・・。

【46952】Re:ハイパーリンクでMDBファイル内の指定...
発言  ichinose  - 07/2/23(金) 7:59 -

引用なし
パスワード
   ▼susan さん:
おはようございます。

>HYPERLINK関数で他のブックの指定したシートを開く方法はわかったのですが
> (例)=HYPERLINK("BOOK1.xls#'Sheet1'!A1","他のブックのシートを開く")
>
>同じような方法でMS-ACCESSのMDBファイル内の指定したテーブルを開くことはできるのでしょうか。
このとおりの仕様にするのは面倒かもしれませんよ!!


1 ユーザー定義関数(例えば Myhyper)で指定セルにハイパーリンク設定時のような
  動作を可能にする
 (セルの指定文字列に色を付けてポイント時にはマウスを手の形に代える動作)
2 FollowHyperlinkイベントで上記のユーザー定義関数がセルに設定されているか
 をチェックし、設定されていれば、MDBのパスとテーブル名の抜き出し

3 抜き出した MDBファイルパスとテーブル名からアクセスを起動し、
 データベースを開き、テーブルを表示

特に2番の文字列解析が厳密にやると面倒ですね!!


因みにMDBパスと テーブル名が取得できれば
以下のコードでテーブルの表示は出来ます。

標準モジュールに

'================================================================
Option Explicit
Private Declare Function ShowWindow Lib "USER32" _
       (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
'====================================================================
sub openmdbtabl(mymdbpath As Variant, tblnm As Variant)
   With CreateObject("access.application")
    .Visible = True
    ShowWindow .hWndAccessApp, SW_SHOWMAXIMIZED
   .OpenCurrentDatabase mymdbpath
   .DoCmd.OpenTable tblnm
   .DoCmd.Maximize
   End With
End Function

'使い方は例えば
'===================================================================
sub main()

  Call openmdbtabl("D:\データベース\mydb.mdb", "dsptbl")

end sub

【47106】Re:ハイパーリンクでMDBファイル内の指定...
お礼  susan  - 07/2/28(水) 23:48 -

引用なし
パスワード
   susanです

返事が遅れて申し訳ありません。

▼Kein さん:
>開いて何がしたいのでしょーか ? ただレコードを見るだけなら、いくつかの方法が
>考えられますが・・。

EXCELでデータ説明の資料を作成したのですが、データの場所がMDB名とテーブル名
になっています。実際のデータを見たいときに、いちいちMDBを開いてその中から
さらにテーブルを開くよりはスマートかなと思いました。
自分ではなく他の人が見るための資料なので、できるだけ簡単な操作をと思ったのです。


▼ichinose さん:
わざわざプログラムまで示していただきありがとうございます。
なにか応用ができそうですね、少し考えてみます。

【47118】Re:ハイパーリンクでMDBファイル内の指定...
回答  Kein  - 07/3/1(木) 16:14 -

引用なし
パスワード
   >実際のデータを見たいときに
つまりデータを更新するなどの操作はせず、単に見るだけでいいのですね ?
それなら、ご希望の内容に最も沿うと思われる方法を提案します。
まず、ハイパーリンクの設定に関しては、HYPERLINK関数を使った数式を
埋めるのでなく、ワークシートメニューの「挿入」「ハイパーリンク」を
選択して下さい。このとき、当然ですがmdbのデータを落としてくるシート
とは別のシートにハイパーリンクを挿入する必要があります。
で、出てきたダイアログの"表示文字列"に仮に"業種別平均株価データ"
(↓のサンプルの場合)などと、テーブル名を説明するような文字列を入れます。
"ファイル名またはWebページ名"の窓には、HYPERLINK関数の第一引数と同様に、
リンク先を示す文字列を入れます。
そしてVBEを開いて、メニューの「ツール」「参照設定」で Microsoft DAO 3.6
Object Library にチェックを付け、ハイパーリンクを設定したシートの
シートモジュールに以下のようなマクロを入れます。
当然ですがマクロ内の定数 myMdbFile は実際のmdbファイルのフルパスに書き換え、
OpenRecordset の引数も実際のテーブル名に書き換えておいて下さい。
あと飛んでいくリンク先のシート名に合わせて
> With Worksheets("Sheet1")
のところも適当に書き換えて下さい。

そこまで準備ができたらハイパーリンクをクリックすれば、リンク先シートのA1から
1行目のフィールド名に続いて全レコードが入力・表示されます。
なお、項目行+レコード数が、シートの最大行数を超えないように注意して下さい。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
  Dim myCurDb As DAO.Database
  Dim myCurRset As DAO.Recordset
  Dim I As Long
  Const myMdbFile = _
  "C:\Documents and Settings\User\My Documents" & _
  "\DBFiles\マクロ経済指標.mdb"
  
  If Target.Name <> "業種別平均株価データ" Then Exit Sub
  Set myCurDb = OpenDatabase(myMdbFile)
  Set myCurRset = myCurDb.OpenRecordset("業種別平均株価")
  With Worksheets("Sheet1")
    .Cells.ClearContents
    For I = 1 To myCurRset.Fields.Count
      .Cells(1, I).Value = myCurRset.Fields(I - 1).Name
    Next
    .Range("A2").CopyFromRecordset myCurRset
  End With
  myCurRset.Close: Set myCurRset = Nothing
  myCurDb.Close: Set myCurDb = Nothing
End Sub

【47133】Re:ハイパーリンクでMDBファイル内の指定...
発言  ichinose  - 07/3/1(木) 23:11 -

引用なし
パスワード
   こんばんは。

susan さんの仕様で考えてみました。

新規ブックにて試してください。

関数名は Myhyper

機能   mdbファイルの指定されたテーブルにリンクする

呼び出し形式
     Myhyper(AccessDbpath,Tblnm,dsptxt,[opt])
     input AccessDbpath mdbファイルのフルパス
         Tblnm     表示するテーブル名 
         Dsptxt    表示文字列
         opt      内部で使用するパラメータ(指定不可) 


使用例
   
 =Myhyper("D:\郵便番号データベース\yubin.mdb","郵便番号","郵便番号データ")

 =Myhyper(a1,a2,a3)
 ↑この場合は、セルA1,A2、A3に対応する情報が入っているとする


こんな関数を考えます。


まず標準モジュールに

'====================================================================
Option Explicit
Function Myhyper(AccessDbpath As Variant, Tblnm As Variant, Dsptxt As Variant, Optional opt As Long = 0) As Variant
  Dim rng As Range
  If opt <> 1 Then
    Set rng = Application.Caller
    With rng
     .Hyperlinks.Add Anchor:=rng, Address:="", TextToDisplay:=""
     End With
    Myhyper = Dsptxt
  Else
    Myhyper = Array(AccessDbpath, Tblnm)
    End If
End Function


別の標準モジュールに

'==============================================================
Private Declare Function ShowWindow Lib "USER32" _
       (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
'====================================================================
Sub openmdbtabl(mymdbpath As Variant, Tblnm As Variant)
   On Error Resume Next
   With CreateObject("access.application")
    .Visible = True
    ShowWindow .hWndAccessApp, SW_SHOWMAXIMIZED
   .OpenCurrentDatabase mymdbpath
   .DoCmd.OpenTable Tblnm
   .DoCmd.Maximize
   End With
   On Error GoTo 0
End Sub


thisworkbookのモジュールに
'=============================================================
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
  Dim frm As String
  Dim fend As Long
  Dim myarray As Variant
  frm = Left(Trim(Target.Range.Formula), 8)
  If UCase(frm) = UCase("=myhyper") Then
    fend = InStrRev(Trim(Target.Range.Formula), ")") - 1
    myarray = Application.Evaluate(Left(Trim(Target.Range.Formula), fend) & ",1)")
    Call openmdbtabl(myarray(LBound(myarray)), myarray(UBound(myarray)))
    End If
End Sub


上記のマクロ設定後に

適当なセルに

例えば、

=Myhyper("D:\郵便番号データベース\yubin.mdb","郵便番号","郵便番号データ")

と指定してみてください(勿論、mdbファイルのパスやテーブル名は実際に存在する
情報をしていします)。


指定後に上記の関数を設定したセルをクリックしてみてください。

指定されたテーブルが表示されるはずなんですが・・・。


試してみてください

尚、Excel2002、Access2002で確認しました。

【47176】Re:ハイパーリンクでMDBファイル内の指定...
発言  ichinose  - 07/3/3(土) 7:56 -

引用なし
パスワード
   おはようございます。
Excel2002では、前回のコードで作動でしていますが、
久しぶりにExcel2000で作動させたら、テーブルの表示はされますが、
一瞬で消えてしまいました。


>新規ブックにて試してください。
>
>関数名は Myhyper
>
>機能   mdbファイルの指定されたテーブルにリンクする
>
>呼び出し形式
>     Myhyper(AccessDbpath,Tblnm,dsptxt,[opt])
>     input AccessDbpath mdbファイルのフルパス
>         Tblnm     表示するテーブル名 
>         Dsptxt    表示文字列
>         opt      内部で使用するパラメータ(指定不可) 
>
>
>使用例
>   
> =Myhyper("D:\郵便番号データベース\yubin.mdb","郵便番号","郵便番号データ")
>
> =Myhyper(a1,a2,a3)
> ↑この場合は、セルA1,A2、A3に対応する情報が入っているとする
>
>
>こんな関数を考えます。
>
>
>まず標準モジュールに
>
>'====================================================================
>Option Explicit
>Function Myhyper(AccessDbpath As Variant, Tblnm As Variant, Dsptxt As Variant, Optional opt As Long = 0) As Variant
>  Dim rng As Range
>  If opt <> 1 Then
>    Set rng = Application.Caller
>    With rng
>     .Hyperlinks.Add Anchor:=rng, Address:="", TextToDisplay:=""
>     End With
>    Myhyper = Dsptxt
>  Else
>    Myhyper = Array(AccessDbpath, Tblnm)
>    End If
>End Function
>
>
>別の標準モジュールに
>
>'==============================================================
>Private Declare Function ShowWindow Lib "USER32" _
>       (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
>Private Const SW_SHOWMAXIMIZED = 3
Private accobj As Object
>'====================================================================
>Sub openmdbtabl(mymdbpath As Variant, Tblnm As Variant)
>   On Error Resume Next
   set accobj= CreateObject("access.application")
   with accobj
>    .Visible = True
>    ShowWindow .hWndAccessApp, SW_SHOWMAXIMIZED
>   .OpenCurrentDatabase mymdbpath
>   .DoCmd.OpenTable Tblnm
>   .DoCmd.Maximize
>   End With
>   On Error GoTo 0
>End Sub

上記のようにコードを変更すると、Excel2000で指定テーブルが
表示されました。
以上、ご報告まで・・・。


>thisworkbookのモジュールに
>'=============================================================
>Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
>  Dim frm As String
>  Dim fend As Long
>  Dim myarray As Variant
>  frm = Left(Trim(Target.Range.Formula), 8)
>  If UCase(frm) = UCase("=myhyper") Then
>    fend = InStrRev(Trim(Target.Range.Formula), ")") - 1
>    myarray = Application.Evaluate(Left(Trim(Target.Range.Formula), fend) & ",1)")
>    Call openmdbtabl(myarray(LBound(myarray)), myarray(UBound(myarray)))
>    End If
>End Sub

6108 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free