返回列表 上一主題 發帖

[發問] 請問 vba 自製函數 如何列出來

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-2-12 00:49 | 顯示全部帖子
回復 1# cr123a
沒必要這麼麻煩吧!
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-2-12 12:40 | 顯示全部帖子
回復 3# cr123a

基本上在撰寫自訂函數同時，就把函數使用說明寫在程式碼中比較合適
可能你要保密你的程式碼，那麼，只需在開啟此檔案時，於插入函數對話框中加入這些字串即可
舉例來說自訂函數都集中在Module1
如圖

以上圖中的樣式加入說明文字
在Thisworkbook模組內輸入
  1. Private Sub Workbook_Open()
  2. Dim cMdl As Object, Ay$, Ay1$, MyName
  3. Set cMdl = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule '函數所在位置
  4. i = cMdl.CountOfLines
  5.    ar = Split(cMdl.Lines(1, i), Chr(10))
  6.    For i = 0 To UBound(ar)
  7.       If ar(i) <> "" And ar(i) Like "Function *" Then
  8.       n = InStr(ar(i), " ")
  9.       k = InStr(Split(ar(i), " ")(1), "(")
  10.       MyStr = Mid(ar(i), n + 1, k - 1)
  11.          If Ay = "" Then
  12.             Ay = MyStr
  13.          Else
  14.             Ay = Ay & Chr(10) & MyStr
  15.          End If
  16.        End If
  17.       If ar(i) <> "" And InStr(ar(i), "說明") > 0 Then
  18.          If Ay1 = "" Then
  19.             Ay1 = Replace(ar(i), "'", "")
  20.          Else
  21.             Ay1 = Ay1 & Chr(10) & Replace(ar(i), "'", "")
  22.          End If
  23.       End If
  24.    Next
  25.   MyName = Split(Ay, Chr(10))
  26.   MyStr = Split(Ay1, Chr(10))
  27.   For i = 0 To UBound(MyName)
  28.      Application.MacroOptions macro:=MyName(i), Category:=10, Description:=MyStr(i)
  29.   Next
  30. End Sub
複製代碼
於插入函數時即可出現說明文字(如下圖)
  
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2012-2-12 22:10 | 顯示全部帖子
本帖最後由 Hsieh 於 2012-2-12 22:14 編輯

回復 5# cr123a

你是儲存成增益集，那麼必須使用物件類別模組，讓開檔動作能加入說明
物件類別模組
  1. Public WithEvents App As Application
  2. Private Sub App_NewWorkbook(ByVal Wb As Workbook)
  3. Get_Macro
  4. End Sub

  6. Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
  7. Get_Macro
  8. End Sub
複製代碼

一般模組
  1. Public xlApp As New Class1 '宣告 xlApp 為上面自訂的物件模組

  3. Sub Auto_Open() 'Auto_Open會在此檔開啟時自動執行
  4.     Set xlApp.App = Application
  5.     '把自訂模組的 App 設為(也可說連結到)Application物件
  6. End Sub

  8. Sub Get_Macro()
  9. Dim cMdl As Object, Ay$, Ay1$, MyName, i&, k%
  10. Set cMdl = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule '函數所在位置
  11. i = cMdl.CountOfLines
  12.    ar = Split(cMdl.Lines(1, i), Chr(10))
  13.    For i = 0 To UBound(ar)
  14.       If ar(i) <> "" And ar(i) Like "Function *" Then
  15.       n = InStr(ar(i), " ")
  16.       k = InStr(Split(ar(i), " ")(1), "(")
  17.       MyStr = Mid(ar(i), n + 1, k - 1)
  18.          If Ay = "" Then
  19.             Ay = MyStr
  20.          Else
  21.             Ay = Ay & Chr(10) & MyStr
  22.          End If
  23.        End If
  24.       If ar(i) <> "" And InStr(ar(i), "說明") > 0 Then
  25.          If Ay1 = "" Then
  26.             Ay1 = Replace(ar(i), "'", "")
  27.          Else
  28.             Ay1 = Ay1 & Chr(10) & Replace(ar(i), "'", "")
  29.          End If
  30.       End If
  31.    Next
  32.   MyName = Split(Ay, Chr(10))
  33.   MyStr = Split(Ay1, Chr(10))
  34.   For i = 0 To UBound(MyName)
  35.      Application.MacroOptions macro:=MyName(i), Category:=10, Description:=MyStr(i)
  36.   Next
  37. End Sub

  39. '以下為你原本自訂函數程式
  40. Function pkaJPreMath(A)
  41. '說明:pka20120211 每一字串加上符號
  42.   pkaJPreMath = "$ " & A & " $ "
  43. End Function

  45. Function pkaJPreAddBam03(intA, IntB, A)
  46. '說明:pka20120211 每一字串加上 括號 大 中 小
  47.     If intA = 0 Then '不加判別直接加
  48.        If IntB = 1 Then
  49.            pkaJPreAddBam03 = "( " & A & " ) "
  50.         ElseIf IntB = 2 Then
  51.            pkaJPreAddBam03 = "[ " & A & " ] "
  52.         ElseIf IntB = 3 Then
  53.            pkaJPreAddBam03 = "{ " & A & " } "
  54.        End If
  55.     ElseIf intA = 1 Then 'A為負值才加括號
  56.        If IntB = 1 And Mid(A, 1, 1) = "-" Then
  57.            pkaJPreAddBam03 = "( " & A & " ) "
  58.         ElseIf IntB = 2 And Mid(A, 1, 1) = "-" Then
  59.            pkaJPreAddBam03 = "[ " & A & " ] "
  60.         ElseIf IntB = 3 And Mid(A, 1, 1) = "-" Then
  61.            pkaJPreAddBam03 = "{ " & A & " } "
  62.         Else
  63.            pkaJPreAddBam03 = A
  64.         End If
  65.     End If
  66. End Function
複製代碼

載入此增益集後，開新檔案或開啟舊檔後函數類別會多出一個"命令"類別
此處的函數就有說明了
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-2-13 08:22 | 顯示全部帖子
回復 7# cr123a


    討論區不是求檔區
對於回復的內容應該盡力去理解
轉化成自己的知識
若每次只是想得到解答就好
那就不叫討論了
學海無涯_不恥下問

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題