Board logo

標題: [發問] 請問 vba 自製函數 如何列出來 [打印本頁]
作者: cr123a    時間: 2012-2-12 00:01     標題: 請問 vba 自製函數 如何列出來

請問大家  
vba 自製函數太多記不住
有沒有辦法 把自製的函數名稱  全部列出到一個檔案????

謝謝
作者: Hsieh    時間: 2012-2-12 00:49

回復 1# cr123a
沒必要這麼麻煩吧!
[attach]9548[/attach]
作者: cr123a    時間: 2012-2-12 09:15

回復 2# Hsieh


  謝謝您

但是 很多自製函數 日子久了就忘了怎麼用 用法如何??
我是想 把函數名匯出到一個檔案  再打上用法 再印出
以使日後 查尋使用上方便
作者: Hsieh    時間: 2012-2-12 12:40

回復 3# cr123a

基本上在撰寫自訂函數同時，就把函數使用說明寫在程式碼中比較合適
可能你要保密你的程式碼，那麼，只需在開啟此檔案時，於插入函數對話框中加入這些字串即可
舉例來說自訂函數都集中在Module1
如圖
[attach]9549[/attach]
以上圖中的樣式加入說明文字
在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
複製代碼
於插入函數時即可出現說明文字(如下圖)
  [attach]9550[/attach]
作者: cr123a    時間: 2012-2-12 20:29

回復 4# Hsieh


    不是為了保密   
而是一開始犯了一個致命的錯------一開始使用自製新函數 很熟   也認為沒必要加註明  
但久而久之  量大時  很多函數不再常用  就開始遺忘 再加上電腦常出問題的情況下  
就忘了之前的設定 ....................

真是謝謝您  您至少給了我 一個好方向

但我還是沒試出來        [attach]9554[/attach]
作者: Hsieh    時間: 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
複製代碼
[attach]9556[/attach]
一般模組
  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
複製代碼
[attach]9557[/attach]
載入此增益集後，開新檔案或開啟舊檔後函數類別會多出一個"命令"類別
此處的函數就有說明了
[attach]9558[/attach]
作者: cr123a    時間: 2012-2-13 01:05

回復 6# Hsieh


    神神神  厲害!謝謝您了

試了好久 終於試出來了(資質愚鈍)
對大大好像很容易  但終於試出來了!

對於上面的程式碼 我是一無所知  
需不需要去學習它??
還是遇到問題再尋問呢?
作者: Hsieh    時間: 2012-2-13 08:22

回復 7# cr123a


    討論區不是求檔區
對於回復的內容應該盡力去理解
轉化成自己的知識
若每次只是想得到解答就好
那就不叫討論了
作者: cr123a    時間: 2012-2-13 10:32

我了解了
謝謝您的建言
我當竭力去理解!
謝謝!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)