zoukankan      html  css  js  c++  java
  • 20190801OfficeVBA Indenter

    Public Sub SmartIndenterProcedure()
        
        Dim StartLine As Long, EndLine As Long
        Dim LineIndex As Long
        Dim StartCol As Long, EndCol As Long
        Dim LineText As String
        Dim ProcName As String, KeyWord As String
        Dim IndentLevel As Integer, IsAfterUnderLine As Boolean
        Dim IndentThisLine As Boolean, BackThisLine As Boolean
        Dim IndentNextLine As Boolean, BackNextLine As Boolean
        
        
        Set ThisCodePane = ActiveWorkbook.VBProject.VBE.ActiveCodePane    '获取活动代码窗格
        ThisCodePane.GetSelection StartLine, StartCol, EndLine, EndCol    '获取光标位置或选定范围的 起止行列号
        
        ProcName = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcOfLine(StartLine, vbext_pk_Proc)
        StartLine = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcStartLine(ProcName, vbext_pk_Proc)
        EndLine = ActiveWorkbook.VBProject.VBE.SelectedVBComponent.CodeModule.ProcCountLines(ProcName, vbext_pk_Proc) + StartLine
        
        '循环每一行,删除行首缩进
        For LineIndex = StartLine To EndLine
            LineText = ThisCodePane.CodeModule.Lines(LineIndex, 1)
            LineText = RegReplace(LineText, "^s*")
            ThisCodePane.CodeModule.ReplaceLine LineIndex, LineText
        Next LineIndex
        
        
        '设置缩进级别
        IndentLevel = 0
        For LineIndex = StartLine To EndLine
            LineText = ThisCodePane.CodeModule.Lines(LineIndex, 1)
            KeyWord = Left(LineText, IIf(InStr(LineText, " ") = 0, Len(LineText), InStr(LineText, " ") - 1))
            
            Select Case KeyWord
            Case "Do", "For", "Private", "Public", "Select", "Sub", "While", "With", "Function", "Type", "Property"
                IndentNextLine = True                 'After certain keywords, indent next line
            Case "If"                      'After If, where line ends in Then, indent next line
                If Right(LineText, 4) = "Then" Then IndentNextLine = True
                ' If InStr(LineText, " Then ") > 0 Or InStr(LineText, " Then'") > 0 Then IndentNextLine = True
            Case "Loop", "Next", "End"                 'At Loop, Next, End, un-indent this line
                BackThisLine = True
            Case "Case", "Else", "ElseIf"
                BackThisLine = True  'Un-indent Case or Else
                IndentNextLine = True                           'Indent line after Case or Else
                'Case "Public", "Private"
                '    If Split(LineText, " ")(1) = "Sub" Or Split(LineText, " ")(1) = "Function" Then
                '       IndentNextLine = True
                '    End If
            End Select
            
            '判断续行问题
            If Right(LineText, 2) = " _" And IsAfterUnderLine = False Then
                IndentNextLine = True                             'Indent line after underscore
                IsAfterUnderLine = True      'Set a flag to un-indent the line after next
            ElseIf Right(LineText, 2) <> " _" And IsAfterUnderLine Then
                BackNextLine = True
                IsAfterUnderLine = False
            End If
            
            '处理本行的缩进级别
            If IndentThisLine Then
                IndentLevel = IndentLevel + 1
                IndentThisLine = False
            End If
            
            If BackThisLine Then
                IndentLevel = IndentLevel - 1
                BackThisLine = False
            End If
            
            On Error GoTo ErrHandler
            ThisCodePane.CodeModule.ReplaceLine LineIndex, Space$(IndentLevel * 4) & LineText
            On Error GoTo 0
            
            If IndentNextLine Then
                IndentLevel = IndentLevel + 1    '下一行的缩进级别
                IndentNextLine = False
            End If
            
            If BackNextLine Then
                IndentLevel = IndentLevel - 1    '下一行的缩进级别
                BackNextLine = False
            End If
            
        Next LineIndex
        
        Set ThisCodePane = Nothing
        
        Exit Sub
    ErrHandler:
        If IndentLevel < 0 Then IndentLevel = 0  'Will not happen unless extra lines selected
        Resume Next
    End Sub
    
    Private Function RegReplace(ByVal OrgText As String, ByVal Pattern As String, Optional RepStr As String = "") As String
        Dim Regex As Object
        Dim newText As String
        Set Regex = CreateObject("VBScript.RegExp")
        With Regex
            .Global = True
            .Pattern = Pattern
        End With
        newText = Regex.Replace(OrgText, RepStr)
        RegReplace = newText
        Set Regex = Nothing
    End Function
    

      

  • 相关阅读:
    el-select remote 远程搜索 多个共享一个options,options改变时输入框值不显示名称的问题
    vue 中数据共享的方式
    关于AI本质的思考
    人工智能——一场精妙的商业炒作
    相关下载链接
    只用两个问题通关《极限挑战皇家宝藏》最后一关
    常见图片格式详解
    改写《python基础教程》中的一个例子
    介绍四款windows下的神器
    实现windows批处理下的计时功能
  • 原文地址:https://www.cnblogs.com/nextseven/p/11285920.html
Copyright © 2011-2022 走看看