[源码全公开]让你在论坛发布彩色VBA代码

好001

按照老师的步骤,保存到目录下,也加载了,
可是没有菜单,也没有漂亮的颜色..出现这个提示,请老师有空看看

zhaozyuan

原帖由 好001 于 2009-9-2 09:03 发表
按照老师的步骤,保存到目录下,也加载了,
可是没有菜单,也没有漂亮的颜色..出现这个提示,请老师有空看看

你在宏安全性里勾选“信任vba……”那个

lhdcxz

终于看见朽大侠的大作了！怎么说呢？一个“佩服”了得！佩服大侠的学识！佩服大侠的精神！

好001

zhaozyuan

谢谢，已经OK了

zldccmx

原帖由 zhaozyuan 于 2009-9-2 08:08 发表
我2003好像不能用，楼主是2007专用的吧

老朽一直在2003下使用，绝对正常的
相反，我在2007下倒是用的少了，不过在2007下也正常的

zhaozyuan

原帖由 zldccmx 于 2009-9-5 11:05 发表

老朽一直在2003下使用，绝对正常的
相反，我在2007下倒是用的少了，不过在2007下也正常的

谢谢老朽,我的已经正常!!

lyx008

我是初学者，看不懂。

chrisfang

刚刚才看到，真是不错的好东东！
如果只是单纯需要显示为不同的颜色以便查看，使用UltraEdit也可以，而且可以支持多种编程语言，如下面的图所示。当然，没有老朽的这个功能这么强大。

cyano

Private Sub Convertor(ByRef Txt, Hb As Boolean )
    Dim Lf As Long , Tp As Long , Wd As Long , Ht As Long , i As Long , Falg As Boolean , Flag As Boolean
    Dim Tmp As String , K&, StartLine&, J&, Hr&, Pr, Mt&
    Dim CodeMod As CodeModule, Pane As CodePane
    Dim HrLine()
    On Error GoTo 0
    If Application.VBE.MainWindow.Visible = False Then
        MsgBox "执行本代码必须先开启VBE窗口", vbCritical, AppName
        Exit Sub
    End If
    Set Pane = Application.VBE.ActiveCodePane
    If Err.Number <> 0 Then
        MsgBox "您未勾选信任存取 Visual Basic 专案", vbCritical, AppName
        Exit Sub
    End If
    Set CodeMod = Pane.CodeModule
    '取得每个程序的所在列(日后HTML要插入水平线的列数)
    With CodeMod
        K = 0
        StartLine = .CountOfDeclarationLines + 1 '略过声明区
        Do Until StartLine >= .CountOfLines
            StartLine = StartLine + _
                        .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), _
                                        vbext_pk_Proc)
            ReDim Preserve HrLine(K)
            HrLine(K) = StartLine
            K = K + 1
        Loop
    End With
    Lf = 1
    Ht = CodeMod.CountOfLines '全部代码的列数
    '文档名 & 模块名称
    Txt = ""
    ' Verdana 字体
    Txt = Txt & ""
    IExp.document.writeln Txt
    For i = 1 To Ht
        Tmp = CodeMod.Lines(i, 1)
        If Trim(Tmp) <> "" Then
            If Not (Flag Or Left(Trim(Tmp), 1) = "'" Or Len(Trim(Tmp)) = 0) Then
                If Right(Trim(Tmp), 2) = " _" Then Flag = True Else Flag = False
                Select Case Split(Trim(Tmp), " ")(0)
                Case "Sub", "Function"
                    J = 0
                Case "Private", "Public"
                    Select Case Split(Trim(Tmp), " ")(1)
                    Case "Sub", "Function"
                        J = 0
                    End Select
                End Select
                J = J + 1
                If Hb Then Tmp = " If J = 1 Then Tmp = " Else
                If Right(Trim(Tmp), 2) = " _" Then Flag = True Else Flag = False
            End If
            If i <= CodeMod.CountOfDeclarationLines Then
                '处里声明区的程式码
                ConvertCode Tmp, True
                Hr = CodeMod.CountOfDeclarationLines
            Else
                ' 处理过程区代码
                ConvertCode Tmp, True
                Pr = CodeMod.ProcOfLine(i, vbext_pk_Proc)
            End If
            If i - 1 = Hr And Hr <> 0 Then
                '插入水平线 <" & "hr" & ">"
                IExp.document.writeln "<" & "hr" & ">"
            End If
            On Error Resume Next
            Mt = Application.WorksheetFunction.Match(i, HrLine(), 0)
            On Error GoTo 0
            If Mt > 0 Then
                IExp.document.writeln "<" & "hr" & ">"
                Mt = 0
            End If
            Txt = Tmp & "<" & "br" & ">"
            IExp.document.writeln Txt
        End If
    Next i
    IExp.document.writeln ""
End Sub


提个建议, 这样的文字颜色是否会更为适合我们一般在编辑器内看到的呢

[ 本帖最后由 cyano 于 2009-9-16 04:12 编辑 ]

lmj8260

对我等菜鸟,着色不如我多给的注释,