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

好001 · 发表于 2009-9-2 09:03

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

zhaozyuan · 发表于 2009-9-2 15:16

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

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

lhdcxz · 发表于 2009-9-2 17:28

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

好001 · 发表于 2009-9-5 09:38

zhaozyuan

谢谢，已经OK了

zldccmx · 发表于 2009-9-5 11:05

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

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

zhaozyuan · 发表于 2009-9-5 11:10

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

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

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

lyx008 · 发表于 2009-9-9 15:23

我是初学者，看不懂。

chrisfang · 发表于 2009-9-15 23:43

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

cyano · 发表于 2009-9-16 03:49

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 · 发表于 2009-9-17 19:59

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

		自动登录	找回密码
密码			免费注册

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

可是没有菜单,也没有漂亮的颜色..出现这个提示,请老师有空看看