| |
おはようございます。
Excel2002では、前回のコードで作動でしていますが、
久しぶりにExcel2000で作動させたら、テーブルの表示はされますが、
一瞬で消えてしまいました。
>新規ブックにて試してください。
>
>関数名は 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
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
|
|
ichinose
- 07/3/3(土) 7:56 -
