| |
こんばんは。
susan さんの仕様で考えてみました。
新規ブックにて試してください。
関数名は Myhyper
機能 mdbファイルの指定されたテーブルにリンクする
呼び出し形式
Myhyper(AccessDbpath,Tblnm,dsptxt,[opt])
input AccessDbpath mdbファイルのフルパス
Tblnm 表示するテーブル名
Dsptxt 表示文字列
opt 内部で使用するパラメータ（指定不可）
使用例
=Myhyper("D:\郵便番号データベース\yubin.mdb","郵便番号","郵便番号データ")
=Myhyper(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で確認しました。
|
|
ichinose
- 07/3/1(木) 23:11 -
