[推荐]谁说自定义函数不能修改其它单元格的值

wangtx218

谢谢大师，我慢慢消化

彭希仁

arhJBPzd.rar (162.76 KB, 下载次数: 1797)

2008-7-17 15:39 上传

点击文件名下载附件
[推荐]谁说自定义函数不能修改其它单元格的值

做了一个比较好玩的实例,可以用函数调用VBA程序或运行工作表中的VBA代码.

模块

Public yunx
Public yunxi As String
Function 运行(a)
    On Error GoTo ren
    运行 = "运行"
    yunxi = "Sub xi()" & Chr(10)
    arr = a
    For i = 1 To UBound(arr)
        If arr(i, 1) Like "range*" Or arr(i, 1) Like "Range*" Then arr(i, 1) = "ActiveSheet." & arr(i, 1)
        If arr(i, 1) <> "" Then yunxi = yunxi & arr(i, 1) & Chr(10)
    Next i
    yunxi = yunxi & "End Sub" & Chr(10)
    Set yunx = New css
    Set yunx.sht = ActiveSheet
    Exit Function
ren:
    If a Like "call*" Or a Like "Call*" Then
        Application.Run Mid(a, 5, Len(a))
        Exit Function
    End If
    yunxi = "sub xi()" & Chr(10) & a & Chr(10) & "end sub"
    Set yunx = New css
    Set yunx.sht = ActiveSheet
End Function

类模块css代码
Public WithEvents sht As Worksheet
Private Sub sht_Change(ByVal Target As Range)
 On Error GoTo ren
    Set yunx.sht = Nothing
    Set yunx = Nothing
    Set s = CreateObject("MSScriptControl.ScriptControl")
    s.Language = "VBScript"
    s.AddObject "ActiveWorkbook", ActiveWorkbook
    s.AddObject "Application", Application
    s.AddObject "Activesheet", ActiveSheet
    s.AddObject "sheets", Sheets
    s.AddObject "cells", Cells
    s.addcode yunxi
    s.Run "xi"
    s.Reset
ren:
End Sub

syz105729913

这世界上的任何事就怕"认真"二字

hhzjxss

一个字：高！

二人了：高人！

三个字：实在高！

四个字：高人高招！

八个字：彭大侠实在是高！

 

[em17]

lihongju

高，学习，谢谢！

zez

高

y3231057

没什么说的，收藏学习！

xowi99

高！

学习了。

 

newysk

很有意思！

AD5000

学习了！

以前一直在想函数怎么能够自己设置格式，问了不少人都无解。

根据彭大师的方法终于搞定了！多谢多谢！