VBE

SetWorkingDir %A_ScriptDir%  ; Ensures a consistent starting directory.
#SingleInstance, Force
; Created by AHK_User
; Example code to read, delete, run or modify VBA code of an Excel file
;~ Menu, tray, NoDefault
Menu, Tray, Icon,,, 1
Menu, Tray, Tip,VBE工具
Menu, Tray, add,退出, MExit
Menu, tray, NoStandard
VBcodeS()
return
#IfWinActive ahk_Class wndClass_desked_gsk
^t::
^q::
^d::
	s:="Ahk_VBE_" . Maths_HStr(A_ThisHotkey)
	if oExcel:=Excel_Get(){
		;~ oExcel.Run(s)
		;~ MsgBox %Ahk_VBE_Ctrl_t%
		VBcode:=%s%
		VBE_Run(VBcode,	s)
	}
return
VBE_Run(VBcode,MacroName,VBEName="ThisWorkbook"){
	global oExcel
	oExcel := Excel_Get()
	; Connect to VBA object
	oVBComponent := oExcel.ActiveWorkbook.VBProject.VBComponents.Item(VBEName)
	; Add VBA code
	LinesCountOld:=oVBComponent.CodeModule.CountOfLines
	;~ MsgBox % LinesCountOld
	oVBComponent.CodeModule.InsertLines(1, VBcode)
	LinesCountNew:=oVBComponent.CodeModule.CountOfLines
	;~ MsgBox % LinesCountNew
	;~ MsgBox % oVBComponent.CodeModule.CountOfLines
	;~ LinesContentOld := oVBComponent.CodeModule.Lines(1,oVBComponent.CodeModule.CountOfLines)
	;~ MsgBox %LinesContentOld%
	; Get VBA Content
	;~ LinesContentNew := oVBComponent.CodeModule.Lines(1,oVBComponent.CodeModule.CountOfLines)
	;~ numLines := oVBComponent.CodeModule.CountOfLines
	; Changes the name of the project
	oExcel.ActiveWorkbook.VBProject.Name := "AHKProject"		;~ 在VBE界面中 , 改变VBProject名称为AHKProject, -可选
	; Run macro
	oExcel.Run("ThisWorkbook." . MacroName)
	; Clear macro
	;~ MsgBox % LinesCountNew-LinesCountOld
	;~ oVBComponent.CodeModule.DeleteLines(1,oVBComponent.CodeModule.CountOfLines)
	oVBComponent.CodeModule.DeleteLines(1,LinesCountNew-LinesCountOld)
}
Excel_Get(WinTitle="ahk_class XLMAIN") {	; by Sean and Jethrow, minor modification by Learning one
	ControlGet, hwnd, hwnd, , Excel71, %WinTitle%
	if !hwnd
		return
	Window := Acc_ObjectFromWindow(hwnd, -16)
	loop
		try
			Application := Window.Application
	catch
		ControlSend, Excel71, {esc}, %WinTitle%
	until !!Application
	return Application
}	; http://www.autohotkey.com/forum/viewtopic.php?p=492448#492448
Maths_HStr(s) {
	;~ s=%A_ThisHotkey%
	StringReplace,s,s,~
	StringReplace,s,s,+,Shift_
	StringReplace,s,s,^,Ctrl_
	StringReplace,s,s,!,Alt_
	StringReplace,s,s,#,Win_
	return s
}
VBcodeS(){
	global
	Ahk_VBE_Ctrl_q=
	(
	Sub AHK_VBE_Ctrl_q()    '当前行转为注释
    Dim nStartLine As Long
    Dim nEndLine   As Long
    Dim nStartCol  As Long
    Dim nEndCol    As Long
    Dim n          As Integer
    Dim oLine     As String
    Dim nLine1     As String
    Dim nLine2     As String
    Dim s          As String
    Dim RegEx      As Object

    With Application.VBE.ActiveCodePane.CodeModule
        .CodePane.GetSelection nStartLine, nStartCol, nEndLine, nEndCol
        For n = nStartLine To nEndLine
            oLine = .Lines(n, 1)

            Set RegEx = CreateObject("VBSCript.RegExp")
            RegEx.Global = False
            RegEx.Pattern = "(^\s*)'(.*)"
            If RegEx.test(oLine) Then
                nLine1 = RegEx.Replace(oLine, "$1")
                nLine2 = RegEx.Replace(oLine, "$2")
                s = nLine1 & nLine2
                .ReplaceLine n, s
            Else
                RegEx.Pattern = "(^\s*)(.*)"
                If RegEx.test(oLine) Then
                    nLine1 = RegEx.Replace(oLine, "$1" & "'")
                    nLine2 = RegEx.Replace(oLine, "$2")
                    s = nLine1 & nLine2
                    .ReplaceLine n, s
                End If
            End If
        Next
        .CodePane.SetSelection nStartLine, nStartCol, nEndLine, nStartCol
    End With
End Sub
	)
	Ahk_VBE_Ctrl_d=
	(
'克隆当前选择 VBE
'CloneType = -1 克隆位置在最末行空白处.
'CloneType = 0 克隆位置在当前行后, 下移模式.
'CloneType = 1 克隆位置在当行行后, 插入模式.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~VBE窗口
Sub AHK_VBE_Ctrl_d(Optional ByVal rngFix As String _
			, Optional ByVal CloneType As Integer = -1)
    Dim n As Long, tmp As String
    Dim nStartLine As Long
    Dim nEndLine   As Long
    Dim nStartCol  As Long
    Dim nEndCol    As Long
    Dim oLine      As String
    Dim sContent   As String

    With Application.VBE.ActiveCodePane.CodeModule
        .CodePane.GetSelection nStartLine, nStartCol, nEndLine, nEndCol
        If nStartLine = nEndLine And nStartCol = nEndCol Then
            sContent = .Lines(nStartLine, 1)
        Else
            For n = nStartLine To nEndLine
                tmp = .Lines(n, 1)
                If n = nEndLine Then tmp = Left(tmp, nEndCol - 1)
                If n = nStartLine Then tmp = Right(tmp, (Len(tmp) - nStartCol) + 1)
                sContent = sContent & IIf(Len(sContent) > 0, Chr(10), "") & _
                    tmp
            Next n
        End If
        .InsertLines nStartLine + 1, sContent
        .CodePane.SetSelection nStartLine, nStartCol, nEndLine, nEndCol
    End With
End Sub
	)
	Ahk_VBE_Ctrl_t=
	(
Sub AHK_VBE_Ctrl_t(Optional ByVal rngFix As String _
			, Optional ByVal CloneType As Integer = -1)
    Dim n As Long, tmp As String
    Dim nStartLine As Long
    Dim nEndLine   As Long
    Dim nStartCol  As Long
    Dim nEndCol    As Long
    Dim oLine      As String
    Dim sContent   As String

    With Application.VBE.ActiveCodePane.CodeModule
        .CodePane.GetSelection nStartLine, nStartCol, nEndLine, nEndCol '取得选择位置起始行号/列号
            sContent = .Lines(nStartLine, nEndLine - nStartLine + 1)    '取得鼠标下的  行内容
            If nStartLine = 1 Then Exit Sub                             '如果在首行, 则退出

        .DeleteLines nStartLine, nEndLine - nStartLine + 1              '删除当前鼠标下的  行内容
        .InsertLines nStartLine - 1, sContent                           '插入之前鼠标下的  行内容
        .CodePane.SetSelection nStartLine, nStartCol, nEndLine, nEndCol '恢复鼠标位置
    End With
End Sub
	)
}
MExit:
ExitApp