目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
82 / 118 ﾂﾘｰ ←次へ　｜　前へ→
【126】Excel の参照設定をVBAで 小僧 05/11/24(木) 11:08 Access[未読]
【127】DAOの参照設定をVBAで 小僧 05/11/24(木) 11:09 Access[未読]
【132】参照設定の値を知る方法 kobasan 05/12/29(木) 12:28 Excel[未読]
【126】Excel の参照設定をVBAで
Access  小僧  - 05/11/24(木) 11:08 -
引用なし
パスワード
   みなさまこんにちは。

題名にある通り、Excelの参照設定を行うコードです。
マクロAutoExec から呼び出すと、自動参照されると思います。

Function Excelの参照設定()
Dim Refs As References
Dim xlsGUID As String
Dim Majo As Long
Dim Mino As Long
Dim i As Long
　
　　xlsGUID = "{00020813-0000-0000-C000-000000000046}"
　　Set Refs = Application.References
　
　　For i = Refs.Count To 1 Step -1
　　　　If Refs(i).IsBroken Then
　　　　　　Debug.Print Refs(i).Guid
　　　　　　Application.References.Remove Refs(i)
　　　　Else
　　　　　　If Refs(i).Guid = xlsGUID Then Application.References.Remove Refs(i)
　　　　End If
　　Next
　　Set Refs = Nothing

　　Select Case SysCmd(acSysCmdAccessVer)
　　　　Case 8: Majo = 1: Mino = 2　'AC97
　　　　Case 9: Majo = 1: Mino = 3　'AC2000
　　　　Case 10: Majo = 1: Mino = 4 'AC2002
　　　　Case 11: Majo = 1: Mino = 5 'AC2003
　　　　Case Else: GoTo ErrEXE
　　End Select

　　Application.References.AddFromGuid xlsGUID, Majo, Mino
　　Exit Function
ErrEXE:
　　MsgBox "エクセルの参照設定を手動で行ってください"
End Function
【127】DAOの参照設定をVBAで
Access  小僧  - 05/11/24(木) 11:09 -
引用なし
パスワード
   DAOも作ってみました。
こちらは最新のものを参照する形にしてみました。

Function DAOの参照設定()
Dim Refs As References
Dim DAOGUID As String
Dim Majo As Long
Dim Mino As Long
Dim i As Long
　
　　DAOGUID = "{00025E01-0000-0000-C000-000000000046}"
　　Set Refs = Application.References
　
　　For i = Refs.Count To 1 Step -1
　　　　If Refs(i).IsBroken Then
　　　　　　Application.References.Remove Refs(i)
　　　　Else
　　　　　　If Refs(i).Guid = DAOGUID Then Application.References.Remove Refs(i)
　　　　End If
　　Next
　　Set Refs = Nothing

　　For i = 1 To 3
　　　　Select Case i
　　　　　　Case 1: Majo = 5: Mino = 0 'DAO3.6
　　　　　　Case 2: Majo = 4: Mino = 0 'DAO3.5
　　　　　　Case 3: Majo = 3: Mino = 5 'DAO2.5/3.5
　　　　End Select
　　　　
　　　　On Error Resume Next
　　　　Application.References.AddFromGuid DAOGUID, Majo, Mino
　　　　If Err.Number = 0 Then Exit For
　　Next
　　
　　Select Case Err.Number
　　　　Case 0
　　　　　　
　　　　Case -2147319779
　　　　　　MsgBox "DAOのライブラリが見つかりませんでした。"
　　　　Case Else
　　　　　　MsgBox Err.Description
　　End Select
End Function
【132】参照設定の値を知る方法
Excel  kobasan  - 05/12/29(木) 12:28 -
引用なし
パスワード
   参照設定のFullPath,GUID,Major,Minorを知る方法。

小僧さんのコードで、Guid, Major, Minor の値の見つけ方が分からなかったので作ってみました。

参照設定の値を書き出す方法として
1.ツール／参照設定で追加したいものを手動で設定してから、「Output参照設定」を実行してください。

参照設定するコードとして。
2.FullPathで参照設定する場合は、SetAddFromFileを実行してください。
3.Guid, Major, Minorで参照設定する場合は、SetAddFromGuidを実行してください。

Option Explicit

Sub Output参照設定()
Dim i As Long, k As Long
Dim Flg As Boolean
Dim ary
　　ActiveSheet.UsedRange.ClearContents
　　MsgBox "Hit any key !!"
　　ary = Array("No.", "Description", "Name", "FullPath", "GUID", _
　　　　　　　　"Major", "Minor", "BuiltIn", "IsBroken")
　　Cells(2, 1).Resize(1, UBound(ary) - 1).Value = ary
　　With Application.VBE.ActiveVBProject.References
　　　　For i = 1 To .Count
　　　　　　Cells(i + 2, 1).Resize(1, UBound(ary) - 1).Value _
　　　　　　　　= Array(i, _
　　　　　　　　.Item(i).Description, _
　　　　　　　　.Item(i).Name, _
　　　　　　　　.Item(i).FullPath, _
　　　　　　　　.Item(i).GUID, _
　　　　　　　　.Item(i).Major, _
　　　　　　　　.Item(i).Minor, _
　　　　　　　　.Item(i).BuiltIn, _
　　　　　　　　.Item(i).IsBroken)
　　　　Next i
　　End With
　　Erase ary
End Sub

Sub SetAddFromFile()
Dim FromFile As String
　　FromFile = "****************"　　'<=======ここにFullPathを記入
　　On Error Resume Next
　　Application.VBE.ActiveVBProject.References.AddFromFile FromFile　'参照設定
　　On Error GoTo 0
End Sub

Sub SetAddFromGuid()
Dim FromGuid As String
Dim Majo As Long
Dim Mino As Long
　　FromGuid = "****************" '<=========ここにGUIDを記入
　　Majo = *　　　　'<===========================ここにMajorを記入
　　Mino = *　　　　'<===========================ここにMinorを記入
　　On Error Resume Next
　　Application.References.AddFromGuid FromGuid, Majo, Mino　'参照設定
　　On Error GoTo 0
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
82 / 118 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：   
0
(SS)C-BOARD v3.8 is Free