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

cr123a

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

謝謝

cr123a

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

Hsieh

回復 7# cr123a


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

cr123a

回復 6# Hsieh


    神神神  厲害!謝謝您了

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

對於上面的程式碼 我是一無所知  
需不需要去學習它??
還是遇到問題再尋問呢?

Hsieh

回復 5# cr123a

你是儲存成增益集，那麼必須使用物件類別模組，讓開檔動作能加入說明
物件類別模組

1. Public WithEvents App As Application
   
2. Private Sub App_NewWorkbook(ByVal Wb As Workbook)
   
3. Get_Macro
   
4. End Sub
   
5. 
   
6. Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
   
7. Get_Macro
   
8. End Sub

複製代碼

下載 (51.99 KB)

2012-2-12 22:08

一般模組

1. Public xlApp As New Class1 '宣告 xlApp 為上面自訂的物件模組
   
2. 
   
3. Sub Auto_Open() 'Auto_Open會在此檔開啟時自動執行
   
4.     Set xlApp.App = Application
   
5.     '把自訂模組的 App 設為(也可說連結到)Application物件
   
6. End Sub
   
7. 
   
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
    
38. 
    
39. '以下為你原本自訂函數程式
    
40. Function pkaJPreMath(A)
    
41. '說明:pka20120211 每一字串加上符號
    
42.   pkaJPreMath = "$ " & A & " $ "
    
43. End Function
    
44. 
    
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

複製代碼

下載 (63.46 KB)

2012-2-12 22:10

載入此增益集後，開新檔案或開啟舊檔後函數類別會多出一個"命令"類別
此處的函數就有說明了

下載 (15.42 KB)

2012-2-12 22:14

cr123a

回復 4# Hsieh


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

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

但我還是沒試出來         pk20120209最新程式.rar (32.76 KB)

下載次數: 4

2012-2-12 20:28

Hsieh

回復 3# cr123a

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

下載 (52.63 KB)

2012-2-12 12:33

以上圖中的樣式加入說明文字
在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

複製代碼

於插入函數時即可出現說明文字(如下圖)
  

下載 (18.15 KB)

2012-2-12 12:39

cr123a

回復 2# Hsieh


  謝謝您

但是 很多自製函數 日子久了就忘了怎麼用 用法如何??
我是想 把函數名匯出到一個檔案  再打上用法 再印出
以使日後 查尋使用上方便

Hsieh

回復 1# cr123a
沒必要這麼麻煩吧!

下載 (99.96 KB)

2012-2-12 00:49