VBA之四--六

----给程序自动加行号

Sub 程序自动加行号()
    Dim nLineNum
    Dim sLindNum As String
    Dim selRge As Range
   
    '以下变量用于"将注释改为蓝色"
    Dim lineProgramRange As Range
    Dim commentRange As Range     '注释范围
    Dim TextLine As String        '每一行程序代码(内容)
    Dim ProgComment As String     '每一行程序代码内的注释文字
    Dim RgnStart As Long
    Dim RgnEnd As Long

    Set selRge=Selection.Range        '首先记录Selection
    For nLineNum=1 to selRge.Paragraphs.Count   '针对每个段落
        sLineNum=str(nLineNum)     '行号转为文字
        sLineNum=LTrim(sLineNum)   '去除字符串开头和结尾的空格
        For i=1 to  (3-Len(sLineNum))       
            sLineNum="0"+sLineNum
        Next i
        sLineNum="#" & sLineNum
        sLineNum=sLinNum+" "
        selRge.Paragraphs(nLineNum).Range.InsertBefore(sLineNum)

        '将注释改为蓝色
        Set lineProgramRange=selRge.Paragraphs(nLineNum).Range
        TextLine=lineProgramRange.Text     '取得整行文字
        CharPos=InStr(1,TextLine,Chr(39))     '寻找注释起始点

        If CharPos<>0 Then
            ProgComment=Mid(TextLine,CharPos+1)     '切割出注释文字
            RgnStart=lineProgramRange.Start
            RgnEnd=lineProgramRange.End
            lineProgramRange.SetRange Start:=RgnStart+CharPos,
                                        End:=RgnEnd
            lineProgramRange.Select
            Selection.Font.ColorIndex=wdBlue        '令注释为蓝色
        End If
    Next nLineNum
End Sub

 

 

VBA之五

1.Excel中激活Word
Application.ActivateMicrosoftApp xlMicrosoftWord
2.Excel中打开文件查找框
  Application.FindFile
3.Excel中运行宏
  Application.Run MacroName:="人口预测" 
4.Excel的保存
 ActiveWorkbook.Save
5.为当前工作簿设置密码
Sub Protect_Book()
 ActiveWorkbook.Protect Password:="Protect",Structure:=True,Windows:=True
End Sub  
6.取消工作簿密码
Sub Unprotect_book()
 Msgbox "取消工作簿保护"
 ActiveWorkbook.UnProtectPassword:="Protect"
End Sub

7.逐行读入WORD文档

Sub Macro1()

'

' Macro1 Macro

' 宏在 2011-7-25 由 djc 录制

    Dim Tmp$()

    Tmp() = Split(ActiveDocument.Range.Text, vbCrLf)

    For i = 0 To UBound(Tmp$)

        Debug.Print Tmp$(i)

    Next i

End Sub

8.将工作薄中的全部n张工作表都在sheet1中建上链接

Sub test2()
    Dim Pt As Range
    Dim i As Integer
    With Sheet1
        Set Pt = .Range("b1")
        For i = 2 To ThisWorkbook.Worksheets.Count
            .Hyperlinks.Add Anchor:=Pt, Address:="", SubAddress:=Worksheets(i).Name & "!A1"
                Set Pt = Pt.Offset(1, 0)
        Next i
    End With
End Sub

 

9.在VBA代码中，如何引用当前工作表中的整行或整列

(1) Range("C:C").Select，表示选择C列。
   Range("C:E").Select，表示选择C列至E列。
(2) Range("1:1").Select，表示选择第一行。
   Range("1:3").Select，表示选择第1行至第3行。
(3) Range("C:C").EntireColumn，表示C列；
   Range("D1").EntireColumn，表示D列。
同样的方式，也可以选择整行，然后可以使用如AutoFit方法对整列或整行进行调整。

 

10.VBE中运行其他EXE程序

Shell ("C:\WINDOWS\SAFlashPlayer.exe")

 

VBA之六--EXCEL VBA两则

函数作用:自动获取指定月的工作日

'################################################################ 

Sub 自动填充工作日(month1 As Integer)

 

    '获取指定月份天数

 

    Dim days As Integer

 

    Dim xdate As Date

 

    xdate = CDate("2008-" + CStr(month1))

 

    '初始化公共变量Col2的值

 

    col2 = 4

 

    '调用自定义Mday()函数获取指定月份的天数

 

    days = MDay(xdate)

 

    '循环获取指定月份的工作日

 

    For i = 1 To days

 

        '声明变量保存指定日期

 

        Dim Curdate As String

 

        Curdate = "2008-" + CStr(month1) + "-" + _

 

                  CStr(i)

 

        '判断指定日期是否为工作日

 

        If Weekday(CDate(Curdate)) <> vbSaturday _

 

                   And Weekday(CDate(Curdate)) <> vbSunday Then

 

            Cells(2, col2) = i

 

            col2 = col2 + 1

 

        End If

 

    Next i

 

End Sub

 

 

'获取指定月份的天数

 

 

Public Function MDay(Optional xdate _

 

                     As Variant = 0) As Integer

 

    If IsDate(xdate) Then

 

        MDay = Day(DateSerial(Year(xdate), _

 

               Month(xdate) + 1, 0))

 

    Else

 

        MDay = 0

 

    End If

 

End Function