├── .gitignore ├── README.md ├── configure.bas ├── core ├── ApplicationEvent.cls ├── ExecuteProcedure.bas ├── coreloader.bas ├── keystrokeAsseser.bas ├── oneliner.bas └── updater.bas ├── doc ├── LICENSE └── sample_user_config_dir │ └── vimx │ ├── plugin │ └── scraping │ │ └── IE_scrayper.bas │ └── user_configure.bas ├── sys_plugin ├── Unite │ ├── UniteCaller.bas │ ├── UniteInterface.frm │ ├── UniteInterface.frx │ ├── form_resizer.bas │ └── unite_command.bas ├── _stash │ ├── AdobeRead.bas │ ├── countOfAppearance.bas │ ├── migemo.bas │ ├── pluskun.bas │ ├── pypy │ │ ├── authorization.py │ │ ├── authorization.pyc │ │ ├── client_secret.json │ │ ├── gmail.py │ │ ├── gmail.pyc │ │ ├── mymodule.py │ │ └── mymodule.pyc │ ├── umekomi.bas │ └── xlwings.bas ├── data_structure │ └── stack.cls ├── miscellaneous │ ├── EditOperation.bas │ ├── FileOperation.bas │ ├── custom_pivot.bas │ ├── fold.bas │ ├── forSelection.bas │ ├── formula_parser.bas │ ├── ktHolidayName.bas │ ├── make_value_paste_file.bas │ ├── sheet_filter.bas │ ├── tmp.bas │ └── utility.bas └── vim │ ├── copyRange.bas │ ├── data │ └── register.xlsx │ └── vimize.bas ├── ver2.4.5 └── vimx.xlam /.gitignore: -------------------------------------------------------------------------------- 1 | ~* 2 | *.un~* 3 | .cache/ 4 | *.swp 5 | *.log 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Overview 2 | ExcelLikeVim provides vim-like interface for Excel aiming to provide 3 | * Vim-like key mapping which has mode notion and is customizable(in ~/vimx/user_configure.bas). 4 | * Extensible plugin system. By default, some plugins are mimicked and included from popular vim plugin like unite. 5 | 6 | # Installation 7 | Go to the [releases page](https://github.com/kjnh10/ExcelLikeVim/releases), download the latest zip file.(Or you can clone this repository) 8 | Then unzip it and put whole folders anywhere you like and register vimx.xlam as Excel addin. 9 | Additionaly you may need to 'Trust access to the VBA project object model' from security center. This is because this addin manages their own codes outside of .xlam file as text file. 10 | Also you may need to set reference to DAO 3.6 library if you are using old excel. 11 | 12 | That's all. 13 | Now you can use Excel like vim! 14 | 15 | If you have some issue, please let me know from [submit an issue](https://github.com/kjnh10/ExcelLikeVim/issues). 16 | 17 | # Usage 18 | * In normal-mode 'hjkl' to move around cells and some other operations. 19 | * To edit values in a cell, enter insert mode by typing 'i' in normal-mode 20 | * You can execute function with a string in command-mode entered by typing ':'in normal-mode 21 | * You can select cells in visual mode entered by 'v' in normal-mode 22 | Please see the section 'Default Key bindings' for more detailed list you can do. 23 | 24 | # Default Keybindings 25 | | Mode | Keystroke | Function name | 26 | | ---------- | :------- | :------------------------------ | 27 | | Normal | `h` | move_left 28 | | Normal | `j` | move_down 29 | | Normal | `k` | move_up 30 | | Normal | `l` | move_right 31 | | Normal | `gg` | gg 32 | | Normal | `G` | G 33 | | Normal | `w` | vim_w 34 | | Normal | `b` | vim_b 35 | | Normal | `` | scroll_up 36 | | Normal | `` | scroll_down 37 | | Normal | `^` | move_head 38 | | Normal | `$` | move_tail 39 | | Normal | `i` | insert_mode 40 | | Normal | `a` | insert_mode 41 | | Normal | `v` | n_v 42 | | Normal | `V` | n_v 43 | | Normal | `:` | command_vim 44 | | Normal | `*` | unite command 45 | | Normal | `/` | find 46 | | Normal | `n` | findNext 47 | | Normal | `N` | findPrevious 48 | | Normal | `o` | insertRowDown 49 | | Normal | `O` | insertRowUp 50 | | Normal | `dd` | n_dd 51 | | Normal | `dc` | n_dc 52 | | Normal | `yy` | n_yy 53 | | Normal | `yv` | yank_value 54 | | Normal | `p` | n_p 55 | | Normal | `u` | n_u 56 | | Normal | `` | n_ESC 57 | | Visual | `` | v_ESC 58 | | Visual | `j` | v_j 59 | | Visual | `k` | v_k 60 | | Visual | `h` | v_h 61 | | Visual | `l` | v_l 62 | | Visual | `gg` | v_gg 63 | | Visual | `G` | v_G 64 | | Visual | `w` | v_w 65 | | Visual | `b` | v_b 66 | | Visual | `` | v_scroll_up 67 | | Visual | `` | v_scroll_down 68 | | Visual | `^` | v_move_head 69 | | Visual | `$` | v_move_tail 70 | | Visual | `a` | v_a 71 | | Visual | `` | v_move_head 72 | | Visual | `` | v_move_tail 73 | | Visual | `:` | command_vim 74 | | Visual | `y` | v_y 75 | | Visual | `d` | v_d 76 | | Visual | `D` | v_D 77 | | Visual | `x` | v_x 78 | | LineVisual | `j` | v_j 79 | | LineVisual | `k` | v_k 80 | | LineVisual | `gg` | v_gg 81 | | LineVisual | `G` | v_G 82 | | LineVisual | `` | v_ESC 83 | | LineVisual | `y` | v_y 84 | | LineVisual | `d` | lv_d 85 | | LineVisual | `x` | lv_d 86 | | Emergency(※) | `F3` | coreloade.reload 87 | 88 | Note that this binding will be lost when some error occurs because this settings are stored as macro variables. 89 | So press 'F3' to reload the settings. Only this key is directly assigned by Application.onkey so that it won't be lost at that time. 90 | 91 | # Customization 92 | ## key mapping 93 | Firstly you need to make *~/vimx/user_configure.bas* 94 | Then editing *~/vimx/user_configure.bas*, you can customize key-mapping and behaviror of some function through setting option. 95 | This configure file will be loaded every time a Excel instance launchs. 96 | ## your plugin 97 | Firstly you need to make directory ~/vimx/plugin/plugin-name/ 98 | If you put on *.bas* *.cls* files under this directory, it will be loaded when you press 'F3' within Excel. 99 | See ExcelLikeVim/doc/sample_user_config_dir/vimx/plugin for a sample. 100 | 101 | ## Example configuration of user_configure.bas 102 | ```vb 103 | Attribute VB_Name = "user_configure" 104 | 105 | Public Sub init() 106 | Application.Cursor = xlNorthwestArrow 107 | Call SetAppEvent 108 | Call keystrokeAsseser.init 109 | call vimize.main 110 | call mykeymap 111 | application.onkey "{F3}", "coreloader.reload" 112 | End Sub 113 | 114 | private sub mykeymap() 115 | 'You can exclude any keys from this software and use them for excel default feature like {^f} => search. 116 | Application.OnKey "^{f}" 117 | Application.OnKey "^{a}" 118 | Application.OnKey "^{c}" 119 | Application.OnKey "^{n}" 120 | Application.OnKey "^{p}" 121 | Application.OnKey "^{s}" 122 | Application.OnKey "^{v}" 123 | Application.OnKey "^{w}" 124 | Application.OnKey "^{x}" 125 | Application.OnKey "^{z}" 126 | Application.OnKey "{F11}" 127 | Application.OnKey "{F12}" 128 | 129 | Call nmap("", "move_head") 130 | Call nmap("", "move_tail") 131 | Call nmap("t", "insertColumnRight") 132 | Call nmap("T", "insertColumnLeft") 133 | Call nmap(";n", "InteriorColor(0)") 134 | Call nmap(";r", "InteriorColor(3)") 135 | Call nmap(";b", "InteriorColor(5)") 136 | Call nmap(";y", "InteriorColor(6)") 137 | Call nmap(";d", "InteriorColor(15)") 138 | Call nmap("m", "merge") 139 | Call nmap("M", "unmerge") 140 | Call nmap(">", "biggerFonts") 141 | Call nmap("<", "smallerFonts") 142 | Call nmap("z", "SetRuledLines") 143 | Call nmap("Z", "UnsetRuledLines") 144 | Call nmap("F9", "toggleVimKeybinde") 145 | Call nmap("F10", "-a updatemodules(ActiveWorkbook.Name)") 146 | Call nmap("", "update") 147 | Call nmap("+", "ZoomInWindow") 148 | Call nmap("-", "ZoomOutWindow") 149 | Call nmap("gs", "SortCurrentColumn") 150 | Call nmap("gF", "focusFromScratch") 151 | Call nmap("gf", "focus") 152 | Call nmap("g-", "exclude") 153 | Call nmap("gc", "filterOff") 154 | Call nmap("H", "ex_left") 155 | Call nmap("J", "ex_below") 156 | Call nmap("K", "ex_up") 157 | Call nmap("L", "ex_right") 158 | Call nmap(",m", "unite mru") 159 | Call nmap(",s", "unite sheet") 160 | Call nmap(",b", "unite book") 161 | Call nmap(",p", "unite project") 162 | Call nmap(",f", "unite filter") 163 | Call nmap("th", "ActivateLeftSheet") 164 | Call nmap("tl", "ActivateRightSheet") 165 | Call nmap("tH", "ActivateFirstSheet") 166 | Call nmap("tL", "ActivateLastSheet") 167 | Call vmap("", "v_move_head") 168 | Call vmap("", "v_move_tail") 169 | Call vmap(";n", "visual_operation InteriorColor(0)") 170 | Call vmap(";r", "visual_operation InteriorColor(3)") 171 | Call vmap(";b", "visual_operation InteriorColor(5)") 172 | Call vmap(";y", "visual_operation InteriorColor(6)") 173 | Call vmap(";d", "visual_operation InteriorColor(15)") 174 | Call vmap("m", "visual_operation merge") 175 | Call vmap("M", "visual_operation unmerge") 176 | Call vmap(">", "visual_operation biggerFonts") 177 | Call vmap("<", "visual_operation smallerFonts") 178 | Call vmap("z", "visual_operation SetRuledLines") 179 | Call vmap("Z", "visual_operation UnsetRuledLines") 180 | Call lvmap(";n", "visual_operation InteriorColor(0)") 181 | Call lvmap(";r", "visual_operation InteriorColor(3)") 182 | Call lvmap(";b", "visual_operation InteriorColor(5)") 183 | Call lvmap(";y", "visual_operation InteriorColor(6)") 184 | Call lvmap(";d", "visual_operation InteriorColor(15)") 185 | Call lvmap("m", "visual_operation merge") 186 | Call lvmap("M", "visual_operation unmerge") 187 | Call lvmap(">", "visual_operation biggerFonts") 188 | Call lvmap("<", "visual_operation smallerFonts") 189 | Call lvmap("z", "visual_operation SetRuledLines") 190 | Call lvmap("Z", "visual_operation UnsetRuledLines") 191 | End Sub 192 | ``` 193 | 194 | # Contributing 195 | Nice that you want to spend some time improving this Addin. 196 | Solving issues is always appreciated. 197 | If you're going to add a feature, it would be best to [submit an issue](https://github.com/kojinho10/ExcelLikeVim/issues). 198 | 199 | -------------------------------------------------------------------------------- /configure.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "configure" 2 | 3 | Public myobject As ApplicationEvent 4 | 5 | Public Sub SetAppEvent() '{{{ 6 | If myobject is Nothing Then 7 | Set myobject = New ApplicationEvent 8 | Set myobject.appEvent = Application 9 | End If 10 | ' MsgBox "setiing AppEvent is done" 11 | End Sub '}}} 12 | 13 | Public Sub init() '{{{ 14 | Call SetAppEvent 15 | Call keystrokeAsseser.init 16 | call vimize.main 17 | 18 | application.onkey "{F3}", "coreloader.reload" 19 | application.onkey "^P", "'ExeStringPro ""unite command""'" 20 | End Sub '}}} 21 | 22 | -------------------------------------------------------------------------------- /core/ApplicationEvent.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ApplicationEvent" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Public WithEvents appEvent As Application 11 | Attribute appEvent.VB_VarHelpID = -1 12 | 13 | Private Sub appevent_WorkbookOpen(ByVal Wb As Workbook) '{{{ 14 | Call UpdateMru(Wb.FullName) 15 | Call cd(Wb.Name) 16 | 17 | ' For Each b in Workbooks 18 | ' If b.Name Like "Book*" Then 19 | ' b.Close 20 | ' End If 21 | ' Next b 22 | 23 | End Sub '}}} 24 | 25 | Private Sub appevent_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean) '{{{ 26 | If Workbooks.count <= 2 Then 27 | On Error Resume Next 28 | Workbooks("register.xlsx").Close savechanges:=False 29 | End If 30 | End Sub '}}} 31 | 32 | Private Sub appevent_SheetActivate(ByVal Sh As Object) '{{{ 33 | ' Debug.Print "App.cls is monitoring.SheetActivate event occured" 34 | Debug.Print Sh.Name 35 | If Sh.Name = "Sheet3" Then 36 | End If 37 | End Sub '}}} 38 | 39 | Private Sub appevent_WorkbookActivate(ByVal Wb As Workbook) '{{{ 40 | 'Debug.Print "App.cls is monitoring.WorkbookActivate event occured" 41 | End Sub '}}} 42 | 43 | '------------------sub Function/Sub----------------------------- 44 | Private Sub UpdateMru(filePath As String) '{{{ 45 | ' record filename which is opend to mru file 46 | openTime = Now 47 | newRegister = True 48 | separator = ":::" 49 | Dim buflines As New Collection 50 | 51 | 'If mru_file does not exist, make mru_file. 52 | Dim mruDir As String: mruDir = Udir & ".cache\" 53 | If dir(mruDir & "mru.txt") = "" Then 54 | If dir(mruDir, vbDirectory) = "" Then 55 | MkDirRecursively mruDir 56 | End If 57 | CreateObject("Scripting.FileSystemObject").CreateTextFile Udir & ".cache\" & "mru.txt" 58 | End If 59 | 60 | Open Udir & ".cache\" & "mru.txt" For Input As #1 61 | Do Until EOF(1) 62 | Line Input #1, buf 63 | If Split(buf, separator)(0) = filePath Then 64 | newRegister = False 65 | count = Val(Split(buf, separator)(1)) 66 | Else 67 | buflines.Add Item:=buf 68 | End If 69 | Loop 70 | Close #1 71 | buflines.Add Item:=filePath & separator & count + 1 & separator & openTime 72 | 73 | Open Udir & ".cache\mru.txt" For Output As #1 74 | For Each record In buflines 75 | Print #1, record 76 | Next record 77 | Close #1 78 | 79 | 'TODO specify which python to use 80 | PYTHONPATH = "python" 81 | On Error Resume Next 82 | Call Shell(PYTHONPATH & " " & ThisWorkbook.Path & "\src\lib\sort.pyw") 83 | On Error GoTo 0 84 | 85 | End Sub '}}} 86 | -------------------------------------------------------------------------------- /core/ExecuteProcedure.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ExecuteProcedure" 2 | 3 | Function ExeStringPro(commandString As String) '{{{ 4 | ' execute function specified by commandString 5 | Dim commandArray() As String 6 | commandString = Replace(commandString, "::", "!") 7 | commandArray = Split(commandString, " ") 8 | 9 | If commandArray(0) = "-a" Then 'execute as is 10 | commandString = Mid(commandString, Instr(commandString, " ") + 1) 'get after #2 space 11 | ExecuteAsIs commandString 12 | Exit Function 13 | End If 14 | 15 | ' Application.Run ("'KiriMacro_20200107-64bit.xlsm'!jumpmore") 16 | Set buf = ExeStringPro_core(commandArray) 17 | If buf(1) = 0 Then 18 | Call SetVariant(ExeStringPro, buf(2)) 19 | Else 20 | MsgBox "specified function:" & commandString & " failed. check that the function exists and args are valid." 21 | End If 22 | End Function '}}} 23 | 24 | Function ExeStringPro_core(commandArray) As Variant '{{{ 25 | 'return (Err.Number, result) 26 | Dim buf As New Collection 27 | 28 | 'Debug.Print "Start ExeStringPro_core" 29 | 'TODO: case for the number of args is greater than 3 30 | On Error GoTo MyError 31 | If UBound(commandArray) = 0 Then 32 | debug.print commandArray(0) 33 | Call SetVariant(result, Application.run(commandArray(0))) 34 | ElseIf UBound(commandArray) = 1 Then 35 | Call SetVariant(result, Application.run(commandArray(0), commandArray(1))) 36 | ElseIf UBound(commandArray) = 2 Then 37 | Call SetVariant(result, Application.run(commandArray(0), commandArray(1), commandArray(2))) 38 | End If 39 | 40 | MyError: 41 | buf.Add Err.Number 'return 0 if no error 42 | buf.Add result 43 | Set ExeStringPro_core = buf 44 | Set buf = Nothing 45 | End Function '}}} 46 | 47 | Sub SetVariant(a As Variant, b As Variant)'{{{ 48 | If IsObject(b) Then 49 | Set a = b 50 | Else 51 | Let a = b 52 | End If 53 | End Sub'}}} 54 | 55 | Function ExecuteAsIs(code As String)'{{{ 56 | 'Todo return value but that seems to be a little bit dangerous 57 | 58 | With ThisWorkbook.VBProject.VBComponents("oneliner").CodeModule 59 | .DeleteLines StartLine:=1, count:=.CountOfLines 60 | .InsertLines 1, "Sub temp_for_ExecuteAsIs()" 61 | .InsertLines 2, "End Sub" 62 | .InsertLines 2, code 63 | End With 64 | DoEvents 65 | Application.Run("temp_for_ExecuteAsIs") 66 | End Function'}}} 67 | 68 | Public Function ExecCommand(sCommand As String, sResult As String) As Boolean '{{{ 69 | 'http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetDosResult.html 70 | 71 | Dim oShell As Object, oExec As Object 72 | Set oShell = CreateObject("WScript.Shell") 73 | Set oExec = oShell.Exec("%ComSpec% /c " & sCommand) 74 | 75 | ' wait the process finished 76 | Do Until oExec.status: DoEvents: Loop 77 | 78 | ' set result 79 | If Not oExec.StdErr.AtEndOfStream Then 80 | ExecCommand = True 81 | sResult = oExec.StdErr.ReadAll 82 | ElseIf Not oExec.StdOut.AtEndOfStream Then 83 | sResult = oExec.StdOut.ReadAll 84 | End If 85 | 86 | ' release the reference of obeject variable 87 | Set oExec = Nothing: Set oShell = Nothing 88 | End Function '}}} 89 | 90 | -------------------------------------------------------------------------------- /core/coreloader.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/core/coreloader.bas -------------------------------------------------------------------------------- /core/keystrokeAsseser.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "keystrokeAsseser" 2 | 3 | #If VBA7 And Win64 Then 4 | Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer 5 | Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As LongLong 6 | Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongLong 'for monitoring 7 | #Else 8 | Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 9 | Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long 10 | Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long 'for monitoring 11 | #End If 12 | 13 | Private Const timeoutLen As Single = 1000 'wait time for hitting next 14 | Private keyStroke As String 15 | Private isNewStroke As Boolean 16 | Private isGettingNumParams As Boolean 17 | 18 | Private keyMapDic As Object 'Collection of vim_mode_mapping_dictionary 19 | Private visualMap As Object 20 | Private lin_visualMap As Object 21 | Private keybinde As String 22 | Private modeOfVim As String 23 | Private s As Double 'for storing time from when previousley pressing a key 24 | Private numParamString As String 25 | 26 | Public Sub init()'{{{ 27 | isNewStroke = True 28 | isGettingNumParams = False 29 | Set keyMapDic = CreateObject("Scripting.Dictionary") 30 | Call SetModeOfVim("normal") 31 | End Sub'}}} 32 | 33 | Public Sub SetModeOfVim(modeName)'{{{ 34 | modeOfVim = modeName 35 | End Sub'}}} 36 | 37 | Public Function GetModeOfVim() As String '{{{ 38 | GetModeOfVim = modeOfVim 39 | End Function'}}} 40 | 41 | '----------- Application layer mapping----------------------- 42 | Public Sub AllKeyToAssesKeyFunc()'{{{ 43 | Application.OnKey "a", "AssesKey" 44 | Application.OnKey "b", "AssesKey" 45 | Application.OnKey "c", "AssesKey" 46 | Application.OnKey "d", "AssesKey" 47 | Application.OnKey "e", "AssesKey" 48 | Application.OnKey "f", "AssesKey" 49 | Application.OnKey "g", "AssesKey" 50 | Application.OnKey "h", "AssesKey" 51 | Application.OnKey "i", "AssesKey" 52 | Application.OnKey "j", "AssesKey" 53 | Application.OnKey "k", "AssesKey" 54 | Application.OnKey "l", "AssesKey" 55 | Application.OnKey "m", "AssesKey" 56 | Application.OnKey "n", "AssesKey" 57 | Application.OnKey "o", "AssesKey" 58 | Application.OnKey "p", "AssesKey" 59 | Application.OnKey "q", "AssesKey" 60 | Application.OnKey "r", "AssesKey" 61 | Application.OnKey "s", "AssesKey" 62 | Application.OnKey "t", "AssesKey" 63 | Application.OnKey "u", "AssesKey" 64 | Application.OnKey "v", "AssesKey" 65 | Application.OnKey "w", "AssesKey" 66 | Application.OnKey "x", "AssesKey" 67 | Application.OnKey "y", "AssesKey" 68 | Application.OnKey "z", "AssesKey" 69 | 70 | Application.OnKey "0", "AssesKey" 71 | Application.OnKey "1", "AssesKey" 72 | Application.OnKey "2", "AssesKey" 73 | Application.OnKey "3", "AssesKey" 74 | Application.OnKey "4", "AssesKey" 75 | Application.OnKey "5", "AssesKey" 76 | Application.OnKey "6", "AssesKey" 77 | Application.OnKey "7", "AssesKey" 78 | Application.OnKey "8", "AssesKey" 79 | Application.OnKey "9", "AssesKey" 80 | 81 | Application.OnKey "-", "AssesKey" 82 | Application.OnKey "{^}", "AssesKey" 83 | Application.OnKey "@", "AssesKey" 84 | Application.OnKey "{[}", "AssesKey" 85 | Application.OnKey ";", "AssesKey" 86 | Application.OnKey ":", "AssesKey" 87 | Application.OnKey "{]}", "AssesKey" 88 | Application.OnKey ",", "AssesKey" 89 | Application.OnKey ".", "AssesKey" 90 | Application.OnKey "/", "AssesKey" 91 | Application.OnKey "=", "AssesKey" 92 | Application.OnKey "{+}", "AssesKey" 93 | Application.OnKey ">", "AssesKey" 94 | Application.OnKey "<", "AssesKey" 95 | Application.OnKey "?", "AssesKey" 96 | Application.OnKey "|", "AssesKey" 97 | Application.OnKey "'", "AssesKey" 98 | Application.OnKey "*", "AssesKey" 99 | Application.OnKey "{{}", "AssesKey" 100 | Application.OnKey "{}}", "AssesKey" 101 | Application.OnKey "{(}", "AssesKey" 102 | Application.OnKey "{)}", "AssesKey" 103 | Application.OnKey "!", "AssesKey" 104 | Application.OnKey "#", "AssesKey" 105 | 106 | Application.OnKey "+{a}", "AssesKey" 107 | Application.OnKey "+{b}", "AssesKey" 108 | Application.OnKey "+{c}", "AssesKey" 109 | Application.OnKey "+{d}", "AssesKey" 110 | Application.OnKey "+{e}", "AssesKey" 111 | Application.OnKey "+{f}", "AssesKey" 112 | Application.OnKey "+{g}", "AssesKey" 113 | Application.OnKey "+{h}", "AssesKey" 114 | Application.OnKey "+{i}", "AssesKey" 115 | Application.OnKey "+{j}", "AssesKey" 116 | Application.OnKey "+{k}", "AssesKey" 117 | Application.OnKey "+{l}", "AssesKey" 118 | Application.OnKey "+{m}", "AssesKey" 119 | Application.OnKey "+{n}", "AssesKey" 120 | Application.OnKey "+{o}", "AssesKey" 121 | Application.OnKey "+{p}", "AssesKey" 122 | Application.OnKey "+{q}", "AssesKey" 123 | Application.OnKey "+{r}", "AssesKey" 124 | Application.OnKey "+{s}", "AssesKey" 125 | Application.OnKey "+{t}", "AssesKey" 126 | Application.OnKey "+{u}", "AssesKey" 127 | Application.OnKey "+{v}", "AssesKey" 128 | Application.OnKey "+{w}", "AssesKey" 129 | Application.OnKey "+{x}", "AssesKey" 130 | Application.OnKey "+{y}", "AssesKey" 131 | Application.OnKey "+{z}", "AssesKey" 132 | Application.OnKey "+0", "AssesKey" 133 | Application.OnKey "+1", "AssesKey" 134 | Application.OnKey "+2", "AssesKey" 135 | Application.OnKey "+3", "AssesKey" 136 | Application.OnKey "+4", "AssesKey" 137 | Application.OnKey "+5", "AssesKey" 138 | Application.OnKey "+6", "AssesKey" 139 | Application.OnKey "+7", "AssesKey" 140 | Application.OnKey "+8", "AssesKey" 141 | Application.OnKey "+9", "AssesKey" 142 | 143 | Application.OnKey "^{a}", "AssesKey" 144 | Application.OnKey "^{b}", "AssesKey" 145 | Application.OnKey "^{c}", "AssesKey" 146 | Application.OnKey "^{d}", "AssesKey" 147 | Application.OnKey "^{e}", "AssesKey" 148 | Application.OnKey "^{f}", "AssesKey" 149 | Application.OnKey "^{g}", "AssesKey" 150 | Application.OnKey "^{h}", "AssesKey" 151 | Application.OnKey "^{i}", "AssesKey" 152 | Application.OnKey "^{j}", "AssesKey" 153 | Application.OnKey "^{k}", "AssesKey" 154 | Application.OnKey "^{l}", "AssesKey" 155 | Application.OnKey "^{m}", "AssesKey" 156 | Application.OnKey "^{n}", "AssesKey" 157 | Application.OnKey "^{o}", "AssesKey" 158 | Application.OnKey "^{p}", "AssesKey" 159 | Application.OnKey "^{q}", "AssesKey" 160 | Application.OnKey "^{r}", "AssesKey" 161 | Application.OnKey "^{s}", "AssesKey" 162 | Application.OnKey "^{t}", "AssesKey" 163 | Application.OnKey "^{u}", "AssesKey" 164 | Application.OnKey "^{v}", "AssesKey" 165 | Application.OnKey "^{w}", "AssesKey" 166 | Application.OnKey "^{x}", "AssesKey" 167 | Application.OnKey "^{y}", "AssesKey" 168 | Application.OnKey "^{z}", "AssesKey" 169 | Application.OnKey "^0", "AssesKey" 170 | Application.OnKey "^1", "AssesKey" 171 | Application.OnKey "^2", "AssesKey" 172 | Application.OnKey "^3", "AssesKey" 173 | Application.OnKey "^4", "AssesKey" 174 | Application.OnKey "^5", "AssesKey" 175 | Application.OnKey "^6", "AssesKey" 176 | Application.OnKey "^7", "AssesKey" 177 | Application.OnKey "^8", "AssesKey" 178 | Application.OnKey "^9", "AssesKey" 179 | 180 | Application.OnKey "{F1}", "AssesKey" 181 | Application.OnKey "{F2}", "AssesKey" 182 | Application.OnKey "{F3}", "AssesKey" 183 | Application.OnKey "{F4}", "AssesKey" 184 | Application.OnKey "{F5}", "AssesKey" 185 | Application.OnKey "{F6}", "AssesKey" 186 | Application.OnKey "{F7}", "AssesKey" 187 | Application.OnKey "{F8}", "AssesKey" 188 | Application.OnKey "{F9}", "AssesKey" 189 | Application.OnKey "{F10}", "AssesKey" 190 | Application.OnKey "{F11}", "AssesKey" 191 | Application.OnKey "{F12}", "AssesKey" 192 | Application.OnKey "{F13}", "AssesKey" 193 | Application.OnKey "{F14}", "AssesKey" 194 | Application.OnKey "{F15}", "AssesKey" 195 | Application.OnKey "{F16}", "AssesKey" 196 | Application.OnKey "{ESC}", "AssesKey" 197 | End Sub'}}} 198 | 199 | Public Sub AllKeyAssign_reset()'{{{ 200 | Application.OnKey "a" 201 | Application.OnKey "b" 202 | Application.OnKey "c" 203 | Application.OnKey "d" 204 | Application.OnKey "e" 205 | Application.OnKey "f" 206 | Application.OnKey "g" 207 | Application.OnKey "h" 208 | Application.OnKey "i" 209 | Application.OnKey "j" 210 | Application.OnKey "k" 211 | Application.OnKey "l" 212 | Application.OnKey "m" 213 | Application.OnKey "n" 214 | Application.OnKey "o" 215 | Application.OnKey "p" 216 | Application.OnKey "q" 217 | Application.OnKey "r" 218 | Application.OnKey "s" 219 | Application.OnKey "t" 220 | Application.OnKey "u" 221 | Application.OnKey "v" 222 | Application.OnKey "w" 223 | Application.OnKey "x" 224 | Application.OnKey "y" 225 | Application.OnKey "z" 226 | 227 | Application.OnKey "0" 228 | Application.OnKey "1" 229 | Application.OnKey "2" 230 | Application.OnKey "3" 231 | Application.OnKey "4" 232 | Application.OnKey "5" 233 | Application.OnKey "6" 234 | Application.OnKey "7" 235 | Application.OnKey "8" 236 | Application.OnKey "9" 237 | 238 | Application.OnKey "=" 239 | Application.OnKey "-" 240 | Application.OnKey "{^}" 241 | Application.OnKey "?" 242 | Application.OnKey "@" 243 | Application.OnKey "{[}" 244 | Application.OnKey ";" 245 | Application.OnKey ":" 246 | Application.OnKey "{]}" 247 | Application.OnKey "." 248 | 249 | Application.OnKey "+a" 250 | Application.OnKey "+b" 251 | Application.OnKey "+c" 252 | Application.OnKey "+d" 253 | Application.OnKey "+e" 254 | Application.OnKey "+f" 255 | Application.OnKey "+g" 256 | Application.OnKey "+h" 257 | Application.OnKey "+i" 258 | Application.OnKey "+j" 259 | Application.OnKey "+k" 260 | Application.OnKey "+l" 261 | Application.OnKey "+m" 262 | Application.OnKey "+n" 263 | Application.OnKey "+o" 264 | Application.OnKey "+p" 265 | Application.OnKey "+q" 266 | Application.OnKey "+r" 267 | Application.OnKey "+s" 268 | Application.OnKey "+t" 269 | Application.OnKey "+u" 270 | Application.OnKey "+v" 271 | Application.OnKey "+w" 272 | Application.OnKey "+x" 273 | Application.OnKey "+y" 274 | Application.OnKey "+z" 275 | 276 | Application.OnKey "+0" 277 | Application.OnKey "+1" 278 | Application.OnKey "+2" 279 | Application.OnKey "+3" 280 | Application.OnKey "+4" 281 | Application.OnKey "+5" 282 | Application.OnKey "+6" 283 | Application.OnKey "+7" 284 | Application.OnKey "+8" 285 | Application.OnKey "+9" 286 | 287 | Application.OnKey "+-" 288 | Application.OnKey "+{^}" 289 | Application.OnKey "+?" 290 | Application.OnKey "+@" 291 | Application.OnKey "+{[}" 292 | Application.OnKey "+;" 293 | Application.OnKey "+:" 294 | Application.OnKey "+{]}" 295 | Application.OnKey "<" 296 | Application.OnKey "+." 297 | Application.OnKey "+/" 298 | Application.OnKey "_" 299 | 300 | 'Ctrl 301 | Application.OnKey "^a" 302 | Application.OnKey "^b" 303 | Application.OnKey "^c" 304 | Application.OnKey "^d" 305 | Application.OnKey "^e" 306 | Application.OnKey "^f" 307 | Application.OnKey "^g" 308 | Application.OnKey "^h" 309 | Application.OnKey "^i" 310 | Application.OnKey "^j" 311 | Application.OnKey "^k" 312 | Application.OnKey "^l" 313 | Application.OnKey "^m" 314 | Application.OnKey "^n" 315 | Application.OnKey "^o" 316 | Application.OnKey "^p" 317 | Application.OnKey "^q" 318 | Application.OnKey "^r" 319 | Application.OnKey "^s" 320 | Application.OnKey "^t" 321 | Application.OnKey "^u" 322 | Application.OnKey "^v" 323 | Application.OnKey "^w" 324 | Application.OnKey "^x" 325 | Application.OnKey "^y" 326 | Application.OnKey "^z" 327 | 328 | Application.OnKey "^0" 329 | Application.OnKey "^1" 330 | Application.OnKey "^2" 331 | Application.OnKey "^3" 332 | Application.OnKey "^4" 333 | Application.OnKey "^5" 334 | Application.OnKey "^6" 335 | Application.OnKey "^7" 336 | Application.OnKey "^8" 337 | Application.OnKey "^9" 338 | 339 | Application.OnKey "^-" 340 | Application.OnKey "^{^}" 341 | Application.OnKey "^?" 342 | Application.OnKey "^@" 343 | Application.OnKey "^{[}" 344 | Application.OnKey "^;" 345 | Application.OnKey "^:" 346 | Application.OnKey "^{]}" 347 | Application.OnKey "^." 348 | 349 | Application.OnKey "^+a" 350 | Application.OnKey "^+b" 351 | Application.OnKey "^+c" 352 | Application.OnKey "^+d" 353 | Application.OnKey "^+e" 354 | Application.OnKey "^+f" 355 | Application.OnKey "^+g" 356 | Application.OnKey "^+h" 357 | Application.OnKey "^+i" 358 | Application.OnKey "^+j" 359 | Application.OnKey "^+k" 360 | Application.OnKey "^+l" 361 | Application.OnKey "^+m" 362 | Application.OnKey "^+n" 363 | Application.OnKey "^+o" 364 | Application.OnKey "^+p" 365 | Application.OnKey "^+q" 366 | Application.OnKey "^+r" 367 | Application.OnKey "^+s" 368 | Application.OnKey "^+t" 369 | Application.OnKey "^+u" 370 | Application.OnKey "^+v" 371 | Application.OnKey "^+w" 372 | Application.OnKey "^+x" 373 | Application.OnKey "^+y" 374 | Application.OnKey "^+z" 375 | 376 | Application.OnKey "^+0" 377 | Application.OnKey "^+1" 378 | Application.OnKey "^+2" 379 | Application.OnKey "^+3" 380 | Application.OnKey "^+4" 381 | Application.OnKey "^+5" 382 | Application.OnKey "^+6" 383 | Application.OnKey "^+7" 384 | Application.OnKey "^+8" 385 | Application.OnKey "^+9" 386 | 387 | Application.OnKey "^+-" 388 | Application.OnKey "^+{^}" 389 | Application.OnKey "^+?" 390 | Application.OnKey "^+@" 391 | Application.OnKey "^+{[}" 392 | Application.OnKey "^+;" 393 | Application.OnKey "^+:" 394 | Application.OnKey "^+{]}" 395 | Application.OnKey "^<" 396 | Application.OnKey "^+." 397 | Application.OnKey "^+/" 398 | Application.OnKey "^_" 399 | 400 | Application.OnKey "{F1}" 401 | Application.OnKey "{F2}" 402 | ' Application.OnKey "{F3}" 403 | Application.OnKey "{F4}" 404 | Application.OnKey "{F5}" 405 | Application.OnKey "{F6}" 406 | Application.OnKey "{F7}" 407 | Application.OnKey "{F8}" 408 | Application.OnKey "{F9}" 409 | Application.OnKey "{F10}" 410 | Application.OnKey "{F11}" 411 | Application.OnKey "{F12}" 412 | Application.OnKey "{F13}" 413 | Application.OnKey "{F14}" 414 | Application.OnKey "{F15}" 415 | Application.OnKey "{F16}" 416 | End Sub '}}} 417 | 418 | '----------- mapping def function ----------------------- 419 | Public Sub nmap(key, func, optional context = "default")'{{{ 420 | if not keyMapDic.exists(context) then 421 | CreateMap(context) 422 | end if 423 | keyMapDic(context)("normal")(key) = func 424 | End Sub'}}} 425 | 426 | Public Sub vmap(key, func, optional context = "default")'{{{ 427 | if not keyMapDic.exists(context) then 428 | CreateMap(context) 429 | end if 430 | keyMapDic(context)("visual")(key) = func 431 | End Sub'}}} 432 | 433 | Public Sub lvmap(key, func, optional context = "default")'{{{ 434 | if not keyMapDic.exists(context) then 435 | CreateMap(context) 436 | end if 437 | keyMapDic(context)("line_visual")(key) = func 438 | End Sub'}}} 439 | 440 | Private Sub CreateMap(context)'{{{ 441 | Dim tmp As Object 442 | Set tmp = CreateObject("Scripting.Dictionary") 443 | Set normalMap = CreateObject("Scripting.Dictionary") 444 | Set visualMap = CreateObject("Scripting.Dictionary") 445 | Set lin_visualMap = CreateObject("Scripting.Dictionary") 446 | tmp.Add "normal", normalMap 447 | tmp.Add "visual", visualMap 448 | tmp.Add "line_visual", lin_visualMap 449 | keyMapDic.Add context, tmp 450 | End Sub'}}} 451 | 452 | '----------- executer----------------------- 453 | Private Sub AssesKey(optional context As String = "default")'{{{ 454 | ' This function will be called by pressing keys and interpret what to do and execute 455 | 456 | Application.EnableCancelKey = xlDisabled 'for Esc Command. Without this, cannot catch ESC key. 457 | ' 458 | If keyMapDic is Nothing Then 459 | Application.Run("keystrokeAsseser.init") 460 | Application.Run("configure.init") 461 | On Error GoTo except 462 | Application.Run("user_configure.init") 463 | except: 464 | If Err.Number <> 0 Then 465 | Debug.print Err.Description 466 | End If 467 | End If 468 | 469 | s = GetTickCount '0 milisecond 470 | 471 | 'Get put key 472 | If isNewStroke Then 473 | keyStroke = "" 474 | newkey = GetKeyString '�V�K�̏ꍇ�ͤGetKeyboardState���g���B������̊֐��łȂ��Ƥ�̂ǂ���modifierkey�̉e�����󂯂Ă��܂�� 475 | Else 476 | newkey = GetKeyStringAsync 'GetKeyboardState���g���ƑO�̃L�[�̏�񂪎c���Ă��܂��Ă��鎖�����邽�߂�������g��� 477 | End If 478 | 479 | If newkey = "" Then 'When Application.OnKey Works, but GetKeyString does not work.'{{{ 480 | MsgBox "couldn't get newkey" 481 | isNewStroke = True 482 | Exit Sub 483 | End If'}}} 484 | 485 | 'Assess newkey and keyStroke 486 | If IsNumeric(newkey) and isNewStroke Then ' number 487 | numParamString = newkey 488 | isGettingNumParams = True 489 | ElseIf (not isNewStroke) and isGettingNumParams and IsNumeric(newkey) Then 490 | numParamString = numParamString + newkey 491 | ElseIf (not isNewStroke) and isGettingNumParams and (not IsNumeric(newkey)) Then 492 | isGettingNumParams = False 493 | keyStroke = keyStroke + newkey 494 | Else 495 | keyStroke = keyStroke + newkey 496 | End If 497 | 498 | candidate = NumberOfHits(keyStroke, context, modeOfVim) 499 | If candidate > 1 or (candidate = 1 and (not keyMapDic(context)(modeOfVim).Exists(keyStroke))) or isGettingNumParams Then 500 | ' wait next key 501 | isNewStroke = False 502 | e = GetTickCount 503 | 504 | 'wait next input key. 505 | Do until e-s > timeoutLen 506 | key = GetKeyStringAsync '(* GetKeyStringAsync returns "", when nothing is being pressed) 507 | if key = "" Then 'the previously pressed key released before next key coming 508 | Exit Do 509 | End if 510 | 511 | if key <> "" And key <> newkey Then 'the next key pressed before the privious key released 512 | 'AssesKeyCore(key) ' without this line, Application.onkey call next AssesKey() 513 | Exit Sub 514 | End if 515 | e = GetTickCount 516 | Loop 517 | 518 | 'to monitor after the first key released 519 | Do until e-s > timeoutLen 520 | key = GetKeyStringAsync 521 | if key <> "" Then 522 | Exit Sub 523 | End if 524 | e = GetTickCount 525 | Loop 526 | 527 | If not isGettingNumParams and keyMapDic(context)(modeOfVim).Exists(keyStroke) Then 528 | ' Debug.print "have waited for timeoutlen:" & timeoutlen & ", so will execute the stroke:" & KeyStroke 529 | Call ExeStringPro(Trim(keyMapDic(context)(modeOfVim).Item(keyStroke) + " " + numParamString)) 530 | End If 531 | ElseIf candidate = 1 And keyMapDic(context)(modeOfVim).Exists(keyStroke) Then 532 | ' Debug.Print keyMapDic(context)(modeOfVim)(keyStroke) & " called from keystroke" 533 | Call ExeStringPro(Trim(keyMapDic(context)(modeOfVim).Item(keyStroke) + " " + numParamString)) 534 | ' Debug.Print "poformanace time is " & GetTickCount - s 535 | End If 536 | 537 | numParamString = "" 538 | isNewStroke = True 539 | isGettingNumParams = False 540 | End Sub 541 | '}}} 542 | 543 | '-----------supplimental functions----------------------- 544 | Private Function GetKeyStringAsync()'{{{ 545 | 'return pressed key when executing function 546 | 'shift'{{{ 547 | shift = False 548 | If GetAsyncKeyState(16) <> 0 Then shift = True '}}} '<0 not working (why?) 549 | 550 | 'control'{{{ 551 | control = False 552 | If GetAsyncKeyState(17) <> 0 Then control = True'}}} 553 | 554 | 'mainkey'{{{ 555 | mainkey = "" 556 | 'alphabet'{{{ 557 | If GetAsyncKeyState(65) < 0 Then mainkey = "a" 558 | If GetAsyncKeyState(66) < 0 Then mainkey = "b" 559 | If GetAsyncKeyState(67) < 0 Then mainkey = "c" 560 | If GetAsyncKeyState(68) < 0 Then mainkey = "d" 561 | If GetAsyncKeyState(69) < 0 Then mainkey = "e" 562 | If GetAsyncKeyState(70) < 0 Then mainkey = "f" 563 | If GetAsyncKeyState(71) < 0 Then mainkey = "g" 564 | If GetAsyncKeyState(72) < 0 Then mainkey = "h" 565 | If GetAsyncKeyState(73) < 0 Then mainkey = "i" 566 | If GetAsyncKeyState(74) < 0 Then mainkey = "j" 567 | If GetAsyncKeyState(75) < 0 Then mainkey = "k" 568 | If GetAsyncKeyState(76) < 0 Then mainkey = "l" 569 | If GetAsyncKeyState(77) < 0 Then mainkey = "m" 570 | If GetAsyncKeyState(78) < 0 Then mainkey = "n" 571 | If GetAsyncKeyState(79) < 0 Then mainkey = "o" 572 | If GetAsyncKeyState(80) < 0 Then mainkey = "p" 573 | If GetAsyncKeyState(81) < 0 Then mainkey = "q" 574 | If GetAsyncKeyState(82) < 0 Then mainkey = "r" 575 | If GetAsyncKeyState(83) < 0 Then mainkey = "s" 576 | If GetAsyncKeyState(84) < 0 Then mainkey = "t" 577 | If GetAsyncKeyState(85) < 0 Then mainkey = "u" 578 | If GetAsyncKeyState(86) < 0 Then mainkey = "v" 579 | If GetAsyncKeyState(87) < 0 Then mainkey = "w" 580 | If GetAsyncKeyState(88) < 0 Then mainkey = "x" 581 | If GetAsyncKeyState(89) < 0 Then mainkey = "y" 582 | If GetAsyncKeyState(90) < 0 Then mainkey = "z"'}}} 583 | 'number'{{{ 584 | If GetAsyncKeyState(48) < 0 Then mainkey = "0" 585 | If GetAsyncKeyState(49) < 0 Then mainkey = "1" 586 | If GetAsyncKeyState(50) < 0 Then mainkey = "2" 587 | If GetAsyncKeyState(51) < 0 Then mainkey = "3" 588 | If GetAsyncKeyState(52) < 0 Then mainkey = "4" 589 | If GetAsyncKeyState(53) < 0 Then mainkey = "5" 590 | If GetAsyncKeyState(54) < 0 Then mainkey = "6" 591 | If GetAsyncKeyState(55) < 0 Then mainkey = "7" 592 | If GetAsyncKeyState(56) < 0 Then mainkey = "8" 593 | If GetAsyncKeyState(57) < 0 Then mainkey = "9"'}}} 594 | 'symbol'{{{ 595 | If GetAsyncKeyState(186) < 0 Then mainkey = ":" 596 | If GetAsyncKeyState(187) < 0 Then mainkey = ";" 597 | If GetAsyncKeyState(188) < 0 Then mainkey = "," 598 | If GetAsyncKeyState(189) < 0 Then mainkey = "-" 599 | If GetAsyncKeyState(190) < 0 Then mainkey = "." 600 | If GetAsyncKeyState(191) < 0 Then mainkey = "/" 601 | If GetAsyncKeyState(192) < 0 Then mainkey = "@" 602 | If GetAsyncKeyState(219) < 0 Then mainkey = "[" 603 | If GetAsyncKeyState(220) < 0 Then mainkey = "\" 604 | If GetAsyncKeyState(221) < 0 Then mainkey = "]" 605 | If GetAsyncKeyState(222) < 0 Then mainkey = "^"'}}} 606 | 'others'{{{ 607 | If GetAsyncKeyState(23) < 0 Then mainkey = "" 608 | If GetAsyncKeyState(vbKeyEscape) < 0 Then mainkey = "" 609 | If GetAsyncKeyState(24) < 0 Then mainkey = ""'}}} 610 | 'Function key'{{{ 611 | If GetAsyncKeyState(112) < 0 Then mainkey = "F1" 612 | If GetAsyncKeyState(113) < 0 Then mainkey = "F2" 613 | If GetAsyncKeyState(114) < 0 Then mainkey = "F3" 614 | If GetAsyncKeyState(115) < 0 Then mainkey = "F4" 615 | If GetAsyncKeyState(116) < 0 Then mainkey = "F5" 616 | If GetAsyncKeyState(117) < 0 Then mainkey = "F6" 617 | If GetAsyncKeyState(118) < 0 Then mainkey = "F7" 618 | If GetAsyncKeyState(119) < 0 Then mainkey = "F8" 619 | If GetAsyncKeyState(120) < 0 Then mainkey = "F9" 620 | If GetAsyncKeyState(121) < 0 Then mainkey = "F10" 621 | 'If GetAsyncKeyState(122) < 0 Then mainkey = "F11" '�Ȃ���F11���������鎖������̂Ť�㏑�����悤�ɏ�Ɂ�VBE�N���L�[��F11 622 | If GetAsyncKeyState(123) < 0 Then mainkey = "F12" 623 | If GetAsyncKeyState(124) < 0 Then mainkey = "F13" 624 | If GetAsyncKeyState(125) < 0 Then mainkey = "F14" 625 | If GetAsyncKeyState(126) < 0 Then mainkey = "F15" 626 | If GetAsyncKeyState(127) < 0 Then mainkey = "F16" 627 | '}}}'}}} 628 | 629 | ' set result '{{{ 630 | GetkeyStringAsync = "" 631 | 'Debug.print "mainkey" & mainkey 632 | If shift Then 633 | GetKeyStringAsync = UCase(mainkey) 634 | ElseIf control Then 635 | GetKeyStringAsync = "" 636 | Else 637 | GetKeyStringAsync = mainkey 638 | End If'}}} 639 | ' 'Debug.print "execution time of GetKeyString" & GetTickCount - s & "mili second" 640 | End Function'}}} 641 | 642 | Private Function GetKeyString()'{{{ 643 | ' Async can't get keys which is used for modifierkey by nodoka 644 | '{{{ 645 | Dim state(255) As Byte 646 | Call GetKeyboardState(state(0)) 647 | 'http://www.yoshidastyle.net/2007/10/windowswin32api.html 648 | 649 | 'check shift key pressed'{{{ 650 | Dim shift As boolean 651 | shift = False 652 | shift = state(16) >= 128'}}} 653 | 654 | 'check control key pressed'{{{ 655 | Dim control As boolean 656 | control = False 657 | control = state(17) >= 128'}}} 658 | 659 | 'get mainkey'{{{ 660 | Dim mainkey As String : mainkey = "" 661 | 'mainkey 662 | If shift Then 663 | 'number 664 | If state(49) >= 128 Then mainkey = "!" 665 | If state(50) >= 128 Then mainkey = """ 666 | If state(51) >= 128 Then mainkey = "#" 667 | If state(52) >= 128 Then mainkey = "$" 668 | If state(53) >= 128 Then mainkey = "%" 669 | If state(54) >= 128 Then mainkey = "&" 670 | If state(55) >= 128 Then mainkey = "'" 671 | If state(56) >= 128 Then mainkey = "(" 672 | If state(57) >= 128 Then mainkey = ")" 673 | 'alphabet 674 | If state(65) >= 128 Then mainkey = "A" 675 | If state(66) >= 128 Then mainkey = "B" 676 | If state(67) >= 128 Then mainkey = "C" 677 | If state(68) >= 128 Then mainkey = "D" 678 | If state(69) >= 128 Then mainkey = "E" 679 | If state(70) >= 128 Then mainkey = "F" 680 | If state(71) >= 128 Then mainkey = "G" 681 | If state(72) >= 128 Then mainkey = "H" 682 | If state(73) >= 128 Then mainkey = "I" 683 | If state(74) >= 128 Then mainkey = "J" 684 | If state(75) >= 128 Then mainkey = "K" 685 | If state(76) >= 128 Then mainkey = "L" 686 | If state(77) >= 128 Then mainkey = "M" 687 | If state(78) >= 128 Then mainkey = "N" 688 | If state(79) >= 128 Then mainkey = "O" 689 | If state(80) >= 128 Then mainkey = "P" 690 | If state(81) >= 128 Then mainkey = "Q" 691 | If state(82) >= 128 Then mainkey = "R" 692 | If state(83) >= 128 Then mainkey = "S" 693 | If state(84) >= 128 Then mainkey = "T" 694 | If state(85) >= 128 Then mainkey = "U" 695 | If state(86) >= 128 Then mainkey = "V" 696 | If state(87) >= 128 Then mainkey = "W" 697 | If state(88) >= 128 Then mainkey = "X" 698 | If state(89) >= 128 Then mainkey = "Y" 699 | If state(90) >= 128 Then mainkey = "Z" 700 | 'symbol 701 | If state(186) >= 128 Then mainkey = "*" 702 | If state(187) >= 128 Then mainkey = "+" 703 | If state(188) >= 128 Then mainkey = "<<" 704 | If state(189) >= 128 Then mainkey = "=" 705 | If state(190) >= 128 Then mainkey = ">" 706 | If state(191) >= 128 Then mainkey = "?" 707 | If state(192) >= 128 Then mainkey = "`" 708 | If state(219) >= 128 Then mainkey = "{" 709 | If state(220) >= 128 Then mainkey = "|" 710 | If state(221) >= 128 Then mainkey = "}" 711 | If state(222) >= 128 Then mainkey = "~" 712 | Else 713 | If state(48) >= 128 Then mainkey = "0" 714 | If state(49) >= 128 Then mainkey = "1" 715 | If state(50) >= 128 Then mainkey = "2" 716 | If state(51) >= 128 Then mainkey = "3" 717 | If state(52) >= 128 Then mainkey = "4" 718 | If state(53) >= 128 Then mainkey = "5" 719 | If state(54) >= 128 Then mainkey = "6" 720 | If state(55) >= 128 Then mainkey = "7" 721 | If state(56) >= 128 Then mainkey = "8" 722 | If state(57) >= 128 Then mainkey = "9" 723 | 'alphabet 724 | If state(86) >= 128 Then mainkey = "v" 'put first to make visual_mode smooth 725 | If state(65) >= 128 Then mainkey = "a" 726 | If state(66) >= 128 Then mainkey = "b" 727 | If state(67) >= 128 Then mainkey = "c" 728 | If state(68) >= 128 Then mainkey = "d" 729 | If state(69) >= 128 Then mainkey = "e" 730 | If state(70) >= 128 Then mainkey = "f" 731 | If state(71) >= 128 Then mainkey = "g" 732 | If state(72) >= 128 Then mainkey = "h" 733 | If state(73) >= 128 Then mainkey = "i" 734 | If state(74) >= 128 Then mainkey = "j" 735 | If state(75) >= 128 Then mainkey = "k" 736 | If state(76) >= 128 Then mainkey = "l" 737 | If state(77) >= 128 Then mainkey = "m" 738 | If state(78) >= 128 Then mainkey = "n" 739 | If state(79) >= 128 Then mainkey = "o" 740 | If state(80) >= 128 Then mainkey = "p" 741 | If state(81) >= 128 Then mainkey = "q" 742 | If state(82) >= 128 Then mainkey = "r" 743 | If state(83) >= 128 Then mainkey = "s" 744 | If state(84) >= 128 Then mainkey = "t" 745 | If state(85) >= 128 Then mainkey = "u" 746 | If state(87) >= 128 Then mainkey = "w" 747 | If state(88) >= 128 Then mainkey = "x" 748 | If state(89) >= 128 Then mainkey = "y" 749 | If state(90) >= 128 Then mainkey = "z" 750 | 'symbol 751 | If state(186) >= 128 Then mainkey = ":" 752 | If state(187) >= 128 Then mainkey = ";" 753 | If state(188) >= 128 Then mainkey = "," 754 | If state(189) >= 128 Then mainkey = "-" 755 | If state(190) >= 128 Then mainkey = "." 756 | If state(191) >= 128 Then mainkey = "/" 757 | If state(192) >= 128 Then mainkey = "@" 758 | If state(219) >= 128 Then mainkey = "[" 759 | If state(220) >= 128 Then mainkey = "\" 760 | If state(221) >= 128 Then mainkey = "]" 761 | If state(222) >= 128 Then mainkey = "^" 762 | 'others 763 | If state(23) >= 128 Then mainkey = "" 764 | If state(24) >= 128 Then mainkey = "" 765 | If state(vbKeyEscape) >= 128 Then mainkey = "" 766 | End If 767 | 768 | 'Function key'{{{ 769 | If state(112) >= 128 Then mainkey = "F1" 770 | If state(113) >= 128 Then mainkey = "F2" 771 | If state(114) >= 128 Then mainkey = "F3" 772 | If state(115) >= 128 Then mainkey = "F4" 773 | If state(116) >= 128 Then mainkey = "F5" 774 | If state(117) >= 128 Then mainkey = "F6" 775 | If state(118) >= 128 Then mainkey = "F7" 776 | If state(119) >= 128 Then mainkey = "F8" 777 | If state(120) >= 128 Then mainkey = "F9" 778 | If state(121) >= 128 Then mainkey = "F10" 779 | 'If state(122) >= 128 Then mainkey = "F11" '�Ȃ���F11���������鎖������̂Ť�㏑�����悤�ɏ�Ɂ�VBE�N���L�[��F11 780 | If state(123) >= 128 Then mainkey = "F12" 781 | If state(124) >= 128 Then mainkey = "F13" 782 | If state(125) >= 128 Then mainkey = "F14" 783 | If state(126) >= 128 Then mainkey = "F15" 784 | If state(127) >= 128 Then mainkey = "F16" 785 | '}}} 786 | '}}} 787 | 788 | '{{{ 789 | If control Then 790 | GetKeyString = "" 791 | Else 792 | GetKeyString = mainkey 793 | End If'}}} 794 | 795 | End Function'}}} 796 | 797 | Private Function NumberOfHits(stroke As String, context, modeOfVim) As Long'{{{ 798 | 'return the number of candidates from keyMapDic which satisfy the keystroke pressed 799 | s = GetTickCount 800 | 801 | c = 0 802 | keyList = keyMapDic(context)(modeOfVim).Keys 803 | For i = 0 To UBound(keyList) 804 | If InStr(keyList(i), stroke) = 1 Then 805 | c = c + 1 806 | End If 807 | Next i 808 | NumberOfHits = c 809 | 810 | ' ' Debug.print "The executed time of NumberOfHits" & GetTickCount - s & "milli second" 811 | End Function'}}} 812 | 813 | -------------------------------------------------------------------------------- /core/oneliner.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "oneliner" 2 | 3 | Sub ExecuteOneLine() 4 | End Sub 5 | -------------------------------------------------------------------------------- /core/updater.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "updater" 2 | 3 | Public Function UpdateSourcesFromGithub() 4 | Dim instruction As String 5 | Dim result As String 6 | ' instruction = "cd " & ThisWorkbook.Path & " & git clone https://github.com/kojinho10/vimx" 7 | instruction = "cd " & ThisWorkbook.Path & " & git pull origin master" 8 | Call ExecCommand(instruction, result) 9 | Msgbox result 10 | End Function 11 | -------------------------------------------------------------------------------- /doc/LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 kojinho10 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /doc/sample_user_config_dir/vimx/plugin/scraping/IE_scrayper.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/doc/sample_user_config_dir/vimx/plugin/scraping/IE_scrayper.bas -------------------------------------------------------------------------------- /doc/sample_user_config_dir/vimx/user_configure.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "user_configure" 2 | 3 | Public Sub init() '{{{ 4 | call mykeymap 5 | End Sub '}}} 6 | 7 | private sub mykeymap() '{{{ 8 | 'keys used for application default command 9 | Application.OnKey "^{f}" 10 | Application.OnKey "^{a}" 11 | Application.OnKey "^{c}" 12 | Application.OnKey "^{n}" 13 | Application.OnKey "^{p}" 14 | Application.OnKey "^{s}" 15 | Application.OnKey "^{v}" 16 | Application.OnKey "^{w}" 17 | Application.OnKey "^{x}" 18 | Application.OnKey "^{z}" 19 | Application.OnKey "{F11}" 20 | Application.OnKey "{F12}" 21 | 22 | Call nmap("", "move_head") 23 | Call nmap("", "move_tail") 24 | Call nmap("t", "insertColumnRight") 25 | Call nmap("T", "insertColumnLeft") 26 | 27 | 'color shortcut 28 | Call nmap(";n", "InteriorColor(0)") 29 | Call nmap(";r", "InteriorColor(3)") 30 | Call nmap(";b", "InteriorColor(5)") 31 | Call nmap(";y", "InteriorColor(6)") 32 | Call nmap(";d", "InteriorColor(15)") 33 | Call nmap("'n", "FontColor(0)") 34 | Call nmap("'r", "FontColor(3)") 35 | Call nmap("'b", "FontColor(5)") 36 | Call nmap("'y", "FontColor(6)") 37 | Call nmap("'d", "FontColor(15)") 38 | 39 | Call nmap("m", "merge") 40 | Call nmap("M", "unmerge") 41 | Call nmap(">", "biggerFonts") 42 | Call nmap("<<", "smallerFonts") 43 | Call nmap("z", "SetRuledLines") 44 | Call nmap("Z", "UnsetRuledLines") 45 | Call nmap("F9", "AllKeyAssign_reset") 46 | Call nmap("", "update") 47 | Call nmap("+", "ZoomInWindow") 48 | Call nmap("-", "ZoomOutWindow") 49 | Call nmap("gs", "SortCurrentColumn") 50 | Call nmap("gF", "focusFromScratch") 51 | Call nmap("gf", "focus") 52 | Call nmap("g-", "exclude") 53 | Call nmap("gc", "filterOff") 54 | Call nmap("H", "ex_left") 55 | Call nmap("J", "ex_below") 56 | Call nmap("K", "ex_up") 57 | Call nmap("L", "ex_right") 58 | Call nmap(",m", "unite mru") 59 | Call nmap(",s", "unite sheet") 60 | Call nmap(",b", "unite book") 61 | Call nmap(",p", "unite project") 62 | Call nmap(",f", "unite filter") 63 | Call nmap(",l", "unite extlink") 64 | Call nmap("tl", "ActivateLeftSheet") 65 | Call nmap("th", "ActivateRightSheet") 66 | Call nmap("tL", "ActivateLastSheet") 67 | Call nmap("tH", "ActivateFirstSheet") 68 | 69 | Call vmap("", "v_move_head") 70 | Call vmap("", "v_move_tail") 71 | Call vmap(";n", "visual_operation InteriorColor(0)") 72 | Call vmap(";r", "visual_operation InteriorColor(3)") 73 | Call vmap(";b", "visual_operation InteriorColor(5)") 74 | Call vmap(";y", "visual_operation InteriorColor(6)") 75 | Call vmap(";d", "visual_operation InteriorColor(15)") 76 | Call vmap("'n", "visual_operation FontColor(0)") 77 | Call vmap("'r", "visual_operation FontColor(3)") 78 | Call vmap("'b", "visual_operation FontColor(5)") 79 | Call vmap("'y", "visual_operation FontColor(6)") 80 | Call vmap("'d", "visual_operation FontColor(15)") 81 | 82 | Call vmap("m", "visual_operation merge") 83 | Call vmap("M", "visual_operation unmerge") 84 | Call vmap(">", "visual_operation biggerFonts") 85 | Call vmap("<<", "visual_operation smallerFonts") 86 | Call vmap("z", "visual_operation SetRuledLines") 87 | Call vmap("Z", "visual_operation UnsetRuledLines") 88 | 89 | Call lvmap(";n", "visual_operation InteriorColor(0)") 90 | Call lvmap(";r", "visual_operation InteriorColor(3)") 91 | Call lvmap(";b", "visual_operation InteriorColor(5)") 92 | Call lvmap(";y", "visual_operation InteriorColor(6)") 93 | Call lvmap(";d", "visual_operation InteriorColor(15)") 94 | Call lvmap("m", "visual_operation merge") 95 | Call lvmap("M", "visual_operation unmerge") 96 | Call lvmap(">", "visual_operation biggerFonts") 97 | Call lvmap("<<", "visual_operation smallerFonts") 98 | Call lvmap("z", "visual_operation SetRuledLines") 99 | Call lvmap("Z", "visual_operation UnsetRuledLines") 100 | end sub '}}} 101 | -------------------------------------------------------------------------------- /sys_plugin/Unite/UniteCaller.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "UniteCaller" 2 | 3 | Public UniteCandidatesList As Collection ' 4 | Public unite_source As String 5 | Public unite_argument As String 6 | Public isExistPython As Boolean 7 | 8 | Public Sub unite(Optional sourceName As String = "") '{{{ 9 | If sourceName = "" Then 10 | Msgbox "no source name specified" 11 | End If 12 | 13 | On Error GoTo Myerror 14 | Set UniteCandidatesList = ExeStringPro("GatherCandidates_" & sourceName) 15 | On Error GoTo 0 16 | unite_source = sourceName 17 | 18 | UniteInterface.Show 19 | Exit Sub 20 | Myerror: 21 | MsgBox "sourceName is invalid" & Err.Description 22 | End Sub '}}} 23 | 24 | 'mru 25 | Function GatherCandidates_mru() As Collection '{{{ 26 | Dim result As New Collection 27 | Dim reverseResult As New Collection 28 | Set FSO = CreateObject("Scripting.FileSystemObject") 29 | 30 | Open Udir & ".cache\mru.txt" For Input As #1 31 | Do Until EOF(1) 32 | Line Input #1, buf 33 | FileName = Split(buf, ":::")(0) 34 | If True Then 35 | result.Add buf 36 | End If 37 | Loop 38 | Close #1 39 | 40 | If Not isExistPython Then 41 | For i = result.Count to 1 Step -1 42 | reverseResult.Add result(i) 43 | Next 44 | Set GatherCandidates_mru = reverseResult 45 | Else 46 | Set GatherCandidates_mru = result 47 | End If 48 | End Function '}}} 49 | Function defaultAction_mru(arg) 'table is better '{{{ 50 | For Each f in Split(arg, vbCrLf) 51 | SmartOpenBook(f) 52 | Next f 53 | End Function'}}} 54 | 55 | 'sheet 56 | Function GatherCandidates_sheet() As Collection '{{{ 57 | Dim result As New Collection 58 | Dim sh As Worksheet 59 | Set Wb = ActiveWorkbook 60 | For Each sh In Wb.Worksheets 61 | result.Add sh.Name 62 | Next sh 63 | Set GatherCandidates_sheet = result 64 | End Function '}}} 65 | Function defaultAction_sheet(arg) 'table is better '{{{ 66 | Worksheets(arg).Activate 67 | End Function'}}} 68 | 69 | 'book 70 | Function GatherCandidates_book() As Collection '{{{ 71 | Dim result As New Collection 72 | Dim wb As Workbook 73 | 74 | For Each wb In Workbooks() 75 | result.Add wb.Name 76 | Next wb 77 | 78 | Set GatherCandidates_book = result 79 | End Function '}}} 80 | Function defaultAction_book(arg) 'table is better '{{{ 81 | Workbooks(arg).Activate 82 | End Function'}}} 83 | 84 | 'filter 85 | Function GatherCandidates_filter() As Collection '{{{ 86 | Dim ValueCollection As New Collection 87 | Set targetColumnRange = InterSect(GetFilterRange, Columns(ActiveCell.Column)) 88 | Set targetColumnRange = targetColumnRange.SpecialCells(xlCellTypeVisible) 89 | 90 | On Error Resume Next 91 | For Each c in targetColumnRange 92 | If c.Value <> "" Then 93 | Debug.Print c.Value 94 | ValueCollection.Add c.Value, Cstr(c.Value) 95 | End If 96 | Next c 97 | On Error GoTo 0 98 | 99 | Set GatherCandidates_filter = ValueCollection 100 | End Function '}}} 101 | Function defaultAction_filter(SelectionMerged As String) 'table is better '{{{ 102 | Application.ScreenUpdating = False 103 | ' If ActiveSheet.FilterMode Then 104 | ' ActiveSheet.ShowAllData 105 | ' End If 106 | GetFilterRange.AutoFilter field:= ActiveCell.Column - GetFilterRange.Column + 1, Criteria1:=Split(SelectionMerged, vbCrLf), Operator:=xlFilterValues 107 | Call gg() 108 | Call move_down() 109 | End Function '}}} 110 | 111 | 'project 112 | Function GatherCandidates_project() As Collection '{{{ 113 | Dim ValueCollection As New Collection 114 | Set targetColumnRange = InterSect(GetFilterRange, Columns(GetFilterRange.Column)) 115 | 116 | On Error Resume Next 117 | For Each c in targetColumnRange 118 | If c.Value <> "" Then 119 | ValueCollection.Add c.Value, Cstr(c.Value) 120 | End If 121 | Next c 122 | On Error GoTo 0 123 | 124 | Set GatherCandidates_project = ValueCollection 125 | End Function '}}} 126 | Function defaultAction_project(SelectionMerged As String) 'table is better? '{{{ 127 | Application.ScreenUpdating = False 128 | If ActiveSheet.FilterMode Then 129 | ActiveSheet.ShowAllData 130 | End If 131 | GetFilterRange.AutoFilter field:= GetFilterRange.Column, Criteria1:=Split(SelectionMerged, vbCrLf), Operator:=xlFilterValues 132 | Call gg() 133 | Call move_down() 134 | End Function '}}} 135 | 136 | 137 | 'external link 138 | Function GatherCandidates_extlink() As Collection '{{{ 139 | Dim ValueCollection As New Collection 140 | Dim links As Variant 141 | links = ActiveWorkbook.LinkSources(xlExcelLinks) 142 | If not IsEmpty(links) Then 143 | For Each link in links 144 | ValueCollection.Add link 145 | Next link 146 | End If 147 | Set GatherCandidates_extlink = ValueCollection 148 | End Function '}}} 149 | Sub defaultAction_extlink(arg) 'table is better? '{{{ 150 | For Each file in Split(arg, vbCrLf) 151 | change_link(file) 152 | Next file 153 | End Sub '}}} 154 | 155 | Sub change_link(filepath) 156 | Dim new_file As Variant 157 | parent_folder = Left$(filepath, InStrRev(filepath, "\") - 1) 158 | ChDir parent_folder 159 | new_file = Application.GetOpenFilename(Title:="Change " & filepath & " to: ") 160 | If VarType(new_file) <> vbBoolean Then 161 | msgbox "changing link " & vbCrLf & "from: " & filepath & vbCrLf & "to: " & new_file 162 | ActiveWorkbook.ChangeLink Name:=filepath, NewName:=new_file, Type:= xlExcelLinks 163 | msgbox "link change finished" 164 | End If 165 | End Sub -------------------------------------------------------------------------------- /sys_plugin/Unite/UniteInterface.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/Unite/UniteInterface.frm -------------------------------------------------------------------------------- /sys_plugin/Unite/UniteInterface.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/Unite/UniteInterface.frx -------------------------------------------------------------------------------- /sys_plugin/Unite/form_resizer.bas: -------------------------------------------------------------------------------- 1 | 2 | Attribute VB_Name = "form_resizer" 3 | 4 | Public Const GWL_STYLE = -16 5 | Public Const WS_CAPTION = &HC00000 6 | Public Const WS_THICKFRAME = &H40000 7 | 8 | #If VBA7 Then 9 | Public Declare PtrSafe Function GetWindowLong _ 10 | Lib "user32" Alias "GetWindowLongA" ( _ 11 | ByVal hWnd As Long, ByVal nIndex As Long) As Long 12 | Public Declare PtrSafe Function SetWindowLong _ 13 | Lib "user32" Alias "SetWindowLongA" ( _ 14 | ByVal hWnd As Long, ByVal nIndex As Long, _ 15 | ByVal dwNewLong As Long) As Long 16 | Public Declare PtrSafe Function DrawMenuBar _ 17 | Lib "user32" (ByVal hWnd As Long) As Long 18 | Public Declare PtrSafe Function FindWindowA _ 19 | Lib "user32" (ByVal lpClassName As String, _ 20 | ByVal lpWindowName As String) As Long 21 | #Else 22 | Public Declare Function GetWindowLong _ 23 | Lib "user32" Alias "GetWindowLongA" ( _ 24 | ByVal hWnd As Long, ByVal nIndex As Long) As Long 25 | Public Declare Function SetWindowLong _ 26 | Lib "user32" Alias "SetWindowLongA" ( _ 27 | ByVal hWnd As Long, ByVal nIndex As Long, _ 28 | ByVal dwNewLong As Long) As Long 29 | Public Declare Function DrawMenuBar _ 30 | Lib "user32" (ByVal hWnd As Long) As Long 31 | Public Declare Function FindWindowA _ 32 | Lib "user32" (ByVal lpClassName As String, _ 33 | ByVal lpWindowName As String) As Long 34 | #End If 35 | 36 | Sub ResizeWindowSettings(frm As Object, show As Boolean) 37 | 38 | Dim windowStyle As Long 39 | Dim windowHandle As Long 40 | 41 | 'Get the references to window and style position within the Windows memory 42 | windowHandle = FindWindowA(vbNullString, frm.Caption) 43 | windowStyle = GetWindowLong(windowHandle, GWL_STYLE) 44 | 45 | 'Determine the style to apply based 46 | If show = False Then 47 | windowStyle = windowStyle And (Not WS_THICKFRAME) 48 | Else 49 | windowStyle = windowStyle + (WS_THICKFRAME) 50 | End If 51 | 52 | 'Apply the new style 53 | SetWindowLong windowHandle, GWL_STYLE, windowStyle 54 | 55 | 'Recreate the UserForm window with the new style 56 | DrawMenuBar windowHandle 57 | 58 | End Sub -------------------------------------------------------------------------------- /sys_plugin/Unite/unite_command.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "unite_command" 2 | 3 | Function GatherCandidates_command() As Collection'{{{ 4 | ' Declare variables to access the Excel 2007 workbook.'{{{ 5 | Dim objXLWorkbooks As Excel.Workbooks 6 | Dim objXLABC As Excel.Workbook'}}} 7 | ' Declare variables to access the macros in the workbook.'{{{ 8 | Dim VBAEditor As VBIDE.VBE 9 | Dim objProject As VBIDE.VBProject 10 | Dim objComponent As VBIDE.VBComponent 11 | Dim objCode As VBIDE.CodeModule'}}} 12 | ' Declare other miscellaneous variables.'{{{ 13 | Dim iLine As Integer 14 | Dim sProcName As String 15 | Dim pk As vbext_ProcKind'}}} 16 | 17 | Dim result As New Collection 18 | ' For Each objComponent In Application.VBE.ActiveVBProject.VBComponents 19 | For Each objComponent In ThisWorkbook.VBProject.VBComponents 20 | ' Find the code module for the project. 21 | Set objCode = objComponent.CodeModule 22 | 23 | ' Scan through the code module, looking for procedures. 24 | iLine = 1 25 | Do While iLine < objCode.CountOfLines 26 | sProcName = objCode.ProcOfLine(iLine, pk) 27 | If sProcName <> "" Then 28 | result.Add objComponent.Name & "." & sProcName 29 | ' Found a procedure. Display its details, and then skip to the end of the procedure. 30 | iLine = iLine + objCode.ProcCountLines(sProcName, pk) 31 | Else 32 | iLine = iLine + 1 33 | End If 34 | Loop 35 | Set objCode = Nothing 36 | Set objComponent = Nothing 37 | Next 38 | Set GatherCandidates_command = result 39 | Set result = Nothing 40 | End Function'}}} 41 | 42 | Function defaultAction_command(arg) 'table is better? '{{{ 43 | For Each f in Split(arg, vbCrLf) 44 | ExeStringPro(f) 45 | Next f 46 | End Function'}}} 47 | 48 | Function defaultAction_command_parent(arg) 'table is better? '{{{ 49 | For Each f in Split(arg, vbCrLf) 50 | Dim g As Variant 51 | For Each g in Split(unite_argument, vbCrlF) 52 | ExeStringPro(f & " " & g) 53 | Next g 54 | Next f 55 | End Function'}}} 56 | 57 | Sub hello(name) 58 | Msgbox name 59 | End Sub 60 | -------------------------------------------------------------------------------- /sys_plugin/_stash/AdobeRead.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/AdobeRead.bas -------------------------------------------------------------------------------- /sys_plugin/_stash/countOfAppearance.bas: -------------------------------------------------------------------------------- 1 | 2 | 3 | Sub kic() 4 | 'countの取得 5 | 'TODO dictionaryで返すようにする｡ 6 | Dim dic As Object 7 | Set dic = CreateObject("scripting.dictionary") 8 | For Each c In Selection 9 | If dic.exists(c.Value) Then 10 | dic(c.Value) = dic(c.Value) + 1 11 | Else 12 | dic(c.Value) = 1 13 | End If 14 | Next c 15 | 16 | For Each c In Selection 17 | c.Offset(0, 1).Value = dic(c.Value) 18 | Next c 19 | End Sub 20 | -------------------------------------------------------------------------------- /sys_plugin/_stash/migemo.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/migemo.bas -------------------------------------------------------------------------------- /sys_plugin/_stash/pluskun.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/pluskun.bas -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/authorization.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | 3 | #https://developers.google.com/gmail/api/quickstart/python(参考) 4 | from datetime import datetime 5 | import os 6 | 7 | from apiclient.discovery import build 8 | from httplib2 import Http 9 | import oauth2client 10 | from oauth2client import client 11 | from oauth2client import tools 12 | 13 | try: 14 | import argparse 15 | flags = argparse.ArgumentParser(parents=[tools.argparser]).parse_args() 16 | except ImportError: 17 | flags = None 18 | 19 | def get_credentials(SCOPES,CLIENT_SECRET_FILE,APPLICATION_NAME): 20 | """Gets valid user credentials from storage. 21 | 22 | If nothing has been stored, or if the stored credentials are invalid, 23 | the OAuth2 flow is completed to obtain the new credentials. 24 | 25 | Returns: 26 | Credentials, the obtained credential. 27 | """ 28 | home_dir = os.path.expanduser('~') 29 | credential_dir = os.path.join(home_dir, '.credentials') 30 | if not os.path.exists(credential_dir): 31 | os.makedirs(credential_dir) 32 | credential_path = os.path.join(credential_dir,'gmail-quickstart.json') 33 | 34 | store = oauth2client.file.Storage(credential_path) 35 | credentials = store.get() 36 | #if not credentials or credentials.invalid: 37 | if not credentials or credentials.invalid: 38 | flow = client.flow_from_clientsecrets(CLIENT_SECRET_FILE, SCOPES) 39 | flow.user_agent = APPLICATION_NAME 40 | if flags: 41 | credentials = tools.run_flow(flow, store, flags) 42 | else: # Needed only for compatability with Python 2.6 43 | credentials = tools.run(flow, store) 44 | print 'Storing credentials to ' + credential_path 45 | return credentials 46 | 47 | -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/authorization.pyc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/pypy/authorization.pyc -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/client_secret.json: -------------------------------------------------------------------------------- 1 | {"installed":{"client_id":"577795074654-krh9kpcr1cfu9mo9cphbei0i4pd547df.apps.googleusercontent.com","auth_uri":"https://accounts.google.com/o/oauth2/auth","token_uri":"https://accounts.google.com/o/oauth2/token","auth_provider_x509_cert_url":"https://www.googleapis.com/oauth2/v1/certs","client_email":"","client_x509_cert_url":"","client_secret":"smG28EMA1nNS0k3QjKxkKZ4j","redirect_uris":["urn:ietf:wg:oauth:2.0:oob","http://localhost"]}} -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/gmail.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | """Send an email message from the user's account. 3 | """ 4 | import authorization 5 | from apiclient.discovery import build 6 | from httplib2 import Http 7 | 8 | import base64 9 | from email.mime.audio import MIMEAudio 10 | from email.mime.base import MIMEBase 11 | from email.mime.image import MIMEImage 12 | from email.mime.multipart import MIMEMultipart 13 | from email.mime.text import MIMEText 14 | import mimetypes 15 | import os 16 | 17 | from apiclient import errors 18 | 19 | SCOPES = 'https://www.googleapis.com/auth/gmail.modify' 20 | CLIENT_SECRET_FILE = 'client_secret.json' 21 | APPLICATION_NAME = 'Gmail' 22 | 23 | def SendMessage(service, user_id, message):# {{{ 24 | """Send an email message. 25 | 26 | Args: 27 | service: Authorized Gmail API service instance. 28 | user_id: User's email address. The special value "me" 29 | can be used to indicate the authenticated user. 30 | message: Message to be sent. 31 | 32 | Returns: 33 | Sent Message. 34 | """ 35 | try: 36 | message = (service.users().messages().send(userId=user_id, body=message) 37 | .execute()) 38 | print 'Message Id: %s' % message['id'] 39 | return message 40 | except errors.HttpError, error: 41 | print 'An error occurred: %s' % error# }}} 42 | 43 | def CreateMessage(sender, to, cc, bcc, subject, message_text):# {{{ 44 | """Create a message for an email. 45 | 46 | Args: 47 | sender: Email address of the sender. 48 | to: Email address of the receiver.(Case multi address:comma separated.) 49 | cc: Email address of the receiver.(Case multi address:comma separated.) 50 | bcc: Email address of the receiver.(Case multi address:comma separated.) 51 | subject: The subject of the email message. 52 | message_text: The text of the email message. 53 | 54 | Returns: 55 | An object containing a base64 encoded email object. 56 | """ 57 | message = MIMEText(message_text) 58 | message['to'] = to 59 | # message['cc'] = cc 60 | # message['bcc'] = bcc 61 | message['from'] = sender 62 | message['subject'] = "=?utf-8?B?" + base64.b64encode(subject) +"?=" 63 | #message['subject'] = subject 64 | return {'raw': base64.b64encode(message.as_string())}# }}} 65 | 66 | def CreateMessageWithAttachment(sender, to, subject, message_text, file_dir, filename):# {{{ 67 | """Create a message for an email. 68 | Args: 69 | sender: Email address of the sender. 70 | to: Email address of the receiver. 71 | subject: The subject of the email message. 72 | message_text: The text of the email message. 73 | file_dir: The directory containing the file to be attached. 74 | filename: The name of the file to be attached. 75 | 76 | Returns: 77 | An object containing a base64 encoded email object. 78 | """ 79 | message = MIMEMultipart() 80 | message['to'] = to 81 | message['from'] = sender 82 | message['subject'] = subject 83 | 84 | msg = MIMEText(message_text) 85 | message.attach(msg) 86 | 87 | path = os.path.join(file_dir, filename) 88 | content_type, encoding = mimetypes.guess_type(path) 89 | 90 | if content_type is None or encoding is not None: 91 | content_type = 'application/octet-stream' 92 | 93 | main_type, sub_type = content_type.split('/', 1) 94 | if main_type == 'text': 95 | fp = open(path, 'rb') 96 | msg = MIMEText(fp.read(), _subtype=sub_type) 97 | fp.close() 98 | elif main_type == 'image': 99 | fp = open(path, 'rb') 100 | msg = MIMEImage(fp.read(), _subtype=sub_type) 101 | fp.close() 102 | elif main_type == 'audio': 103 | fp = open(path, 'rb') 104 | msg = MIMEAudio(fp.read(), _subtype=sub_type) 105 | fp.close() 106 | else: 107 | fp = open(path, 'rb') 108 | msg = MIMEBase(main_type, sub_type) 109 | msg.set_payload(fp.read()) 110 | fp.close() 111 | 112 | #msg.add_header('Content-Disposition', 'attachment', filename=filename) 113 | msg.add_header('Content-Disposition', 'inline', filename=filename) #inlineにすると埋め込まれる｡ 114 | message.attach(msg) 115 | return {'raw': base64.b64encode(message.as_string())}# }}} 116 | 117 | def SendSimpleMail(to, subject, body, user_id="me", cc="", bcc=""):# {{{ 118 | subject = subject.encode("utf-8") 119 | body = body.encode("utf-8") 120 | credentials = authorization.get_credentials(SCOPES,CLIENT_SECRET_FILE,APPLICATION_NAME) 121 | service = build('gmail', 'v1', http=credentials.authorize(Http())) 122 | SendMessage(service, user_id, CreateMessage(user_id, to, cc, bcc, subject, body))# }}} 123 | 124 | if __name__ == '__main__': 125 | subject = u' タイトル ' 126 | body = u""" 127 | 幸治 128 | 渡邉 129 | """ 130 | SendSimpleMail('koji0708phone@gmail.com, koji07082002@gmail.com', subject, body) 131 | 132 | # if __name__ == '__main__': 133 | # credentials = authorization.get_credentials(SCOPES,CLIENT_SECRET_FILE,APPLICATION_NAME) 134 | # service = build('gmail', 'v1', http=credentials.authorize(Http())) 135 | # 136 | # mail = CreateMessageWithAttachment('me','koji0708phone@gmail.com','title','honbunn','C:\\Users\\bc0074854\\Desktop','2014-03-15 14.52.33.jpg') 137 | # 138 | # SendMessage(service, 'me', mail)# }}} 139 | 140 | -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/gmail.pyc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/pypy/gmail.pyc -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/mymodule.py: -------------------------------------------------------------------------------- 1 | import authorization 2 | 3 | from httplib2 import Http 4 | from apiclient.discovery import build 5 | import numpy as np 6 | from xlwings import Workbook, Range 7 | 8 | SCOPES = 'https://www.googleapis.com/auth/gmail.modify' 9 | CLIENT_SECRET_FILE = 'client_secret.json' 10 | APPLICATION_NAME = 'Gmail' 11 | 12 | def test(): 13 | credentials = authorization.get_credentials(SCOPES,CLIENT_SECRET_FILE,APPLICATION_NAME) 14 | service = build('gmail', 'v1', http=credentials.authorize(Http())) 15 | results = service.users().labels().list(userId='me').execute() 16 | labels = results.get('labels', []) 17 | 18 | if not labels: 19 | print 'No labels found.' 20 | else: 21 | print 'Labels:' 22 | i = 1 23 | for label in labels: 24 | try: 25 | wb = Workbook('Book1') 26 | Range((i,1)).value = label['name'].encode("shift-jis") 27 | except: 28 | print "error" 29 | i += 1 30 | 31 | def rand_numbers(): 32 | """ produces standard normally distributed random numbers with shape (n,n)""" 33 | wb = Workbook('Book1') # Creates a reference to the calling Excel file 34 | n = int(Range('Sheet1', 'B1').value) # Write desired dimensions into Cell B1 35 | rand_num = np.random.randn(n, n) 36 | Range('Sheet1', 'C3').value = rand_num 37 | 38 | -------------------------------------------------------------------------------- /sys_plugin/_stash/pypy/mymodule.pyc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/_stash/pypy/mymodule.pyc -------------------------------------------------------------------------------- /sys_plugin/_stash/umekomi.bas: -------------------------------------------------------------------------------- 1 | Sub mawasitene() 2 | Application.ScreenUpdating = False 3 | Dim rowsizes As New Collection 4 | Dim columnsizes As New Collection 5 | 6 | ActiveSheet.Shapes.SelectAll 7 | Selection.Placement = xlMove 8 | 9 | Set buf = ActiveSheet.UsedRange 10 | '行幅の保存'{{{ 11 | r = buf.Rows.Count 12 | c = buf.Columns.Count 13 | For i = 1 To r 14 | rowsizes.Add Rows(i).RowHeight 15 | Next i 16 | 17 | For j = 1 To c 18 | columnsizes.Add Columns(j).ColumnWidth 19 | Next j '}}} 20 | 21 | Rows("1:" & r).RowHeight = 200 22 | Range(Columns(1), Columns(c)).ColumnWidth = 200 23 | 24 | ActiveSheet.Shapes.SelectAll 25 | Selection.Placement = xlMoveAndSize 26 | 27 | '行幅の回復 28 | For i = 1 To r 29 | Rows(i).RowHeight = rowsizes(i) 30 | Next i 31 | 32 | For j = 1 To c 33 | columns(j).ColumnWidth = columnsizes(j) 34 | Next j '}}} 35 | End Sub 36 | -------------------------------------------------------------------------------- /sys_plugin/_stash/xlwings.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlwings" 2 | ' xlwings.org, version: 0.10.0 3 | ' 4 | ' Copyright (C) 2014-2016, Zoomer Analytics LLC (www.zoomeranalytics.com) 5 | ' License: BSD 3-clause (see LICENSE.txt for details) 6 | Option Explicit 7 | #If VBA7 Then 8 | #If Mac Then 9 | Private Declare PtrSafe Function system Lib "libc.dylib" (ByVal Command As String) As Long 10 | #End If 11 | #If Win64 Then 12 | Const XLPyDLLName As String = "xlwings64.dll" 13 | Declare PtrSafe Function XLPyDLLActivateAuto Lib "xlwings64.dll" (ByRef result As Variant, Optional ByVal config As String = "") As Long 14 | Declare PtrSafe Function XLPyDLLNDims Lib "xlwings64.dll" (ByRef src As Variant, ByRef dims As Long, ByRef transpose As Boolean, ByRef dest As Variant) As Long 15 | Declare PtrSafe Function XLPyDLLVersion Lib "xlwings64.dll" (tag As String, version As Double, arch As String) As Long 16 | #Else 17 | Private Const XLPyDLLName As String = "xlwings32.dll" 18 | Private Declare PtrSafe Function XLPyDLLActivateAuto Lib "xlwings32.dll" (ByRef result As Variant, Optional ByVal config As String = "") As Long 19 | Private Declare PtrSafe Function XLPyDLLNDims Lib "xlwings32.dll" (ByRef src As Variant, ByRef dims As Long, ByRef transpose As Boolean, ByRef dest As Variant) As Long 20 | Private Declare PtrSafe Function XLPyDLLVersion Lib "xlwings32.dll" (tag As String, version As Double, arch As String) As Long 21 | #End If 22 | Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long 23 | #Else 24 | #If Mac Then 25 | Private Declare Function system Lib "libc.dylib" (ByVal Command As String) As Long 26 | #End If 27 | Private Const XLPyDLLName As String = "xlwings32.dll" 28 | Private Declare Function XLPyDLLActivateAuto Lib "xlwings32.dll" (ByRef result As Variant, Optional ByVal config As String = "") As Long 29 | Private Declare Function XLPyDLLNDims Lib "xlwings32.dll" (ByRef src As Variant, ByRef dims As Long, ByRef transpose As Boolean, ByRef dest As Variant) As Long 30 | Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long 31 | Declare Function XLPyDLLVersion Lib "xlwings32.dll" (tag As String, version As Double, arch As String) As Long 32 | #End If 33 | 34 | Function Settings(ByRef PYTHON_WIN As String, ByRef PYTHON_MAC As String, ByRef PYTHON_FROZEN As String, ByRef PYTHONPATH As String, ByRef UDF_MODULES As String, ByRef UDF_DEBUG_SERVER As Boolean, ByRef LOG_FILE As String, ByRef SHOW_LOG As Boolean, ByRef OPTIMIZED_CONNECTION As Boolean) 35 | ' PYTHON_WIN: Full path of Python Interpreter on Windows, e.g. "C:\Python35\pythonw.exe". "" resolves to default on PATH 36 | ' PYTHON_MAC: Full path of Python Interpreter on Mac OSX, e.g. "/usr/local/bin/python3.5". "" resolves to default path in ~/.bash_profile 37 | ' PYTHON_FROZEN [Optional]: Currently only on Windows, indicate directory of exe file 38 | ' PYTHONPATH [Optional]: If the source file of your code is not found, add the path here. 39 | ' Separate multiple directories by ";". Otherwise set to "". 40 | ' UDF_MODULES [Optional, Windows only]: Names of Python modules (without .py extension) from which the UDFs are being imported. 41 | ' Separate multiple modules by ";". 42 | ' Example: UDF_MODULES = "common_udfs;myproject" 43 | ' Default: UDF_MODULES = "" defaults to a module in the same directory of the Excel spreadsheet with 44 | ' the same name but ending in ".py". 45 | ' UDF_DEBUG_SERVER: Set this to True if you want to run the xlwings COM server manually for debugging 46 | ' LOG_FILE [Optional]: Leave empty for default location (see docs) or provide directory including file name. 47 | ' SHOW_LOG: If False, no pop-up with the Log messages (usually errors) will be shown 48 | ' OPTIMIZED_CONNECTION (EXPERIMENTAL!): Currently only on Windows, use a COM Server for an efficient connection 49 | ' 50 | ' For cross-platform compatibility, use backslashes in relative directories 51 | ' For details, see http://docs.xlwings.org 52 | 53 | PYTHON_WIN = "" 54 | PYTHON_MAC = "" 55 | PYTHON_FROZEN = ThisWorkbook.Path & "\build\exe.win32-2.7" 56 | PYTHONPATH = ThisWorkbook.Path 57 | UDF_MODULES = "" 58 | UDF_DEBUG_SERVER = False 59 | LOG_FILE = "" 60 | SHOW_LOG = True 61 | OPTIMIZED_CONNECTION = False 62 | 63 | End Function 64 | ' DO NOT EDIT BELOW THIS LINE 65 | 66 | Public Function RunPython(PythonCommand As String) 67 | ' Public API: Runs the Python command, e.g.: to run the function foo() in module bar, call the function like this: 68 | ' RunPython ("import bar; bar.foo()") 69 | 70 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String, UDF_MODULES As String 71 | Dim WORKBOOK_FULLNAME As String, LOG_FILE As String, DriveCommand As String, RunCommand As String 72 | Dim ExitCode As Integer, Res As Integer 73 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 74 | 75 | ' Get the settings by using the ByRef trick 76 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 77 | 78 | ' Call Python platform-dependent 79 | #If Mac Then 80 | Application.StatusBar = "Running..." ' Non-blocking way of giving feedback that something is happening 81 | #If MAC_OFFICE_VERSION >= 15 Then 82 | ExecuteMac PythonCommand, PYTHON_MAC, LOG_FILE, SHOW_LOG, PYTHONPATH 83 | #Else 84 | ExcecuteMac2011 PythonCommand, PYTHON_MAC, LOG_FILE, SHOW_LOG, PYTHONPATH 85 | #End If 86 | #Else 87 | If OPTIMIZED_CONNECTION = True Then 88 | Py.SetAttr Py.Module("xlwings._xlwindows"), "BOOK_CALLER", ThisWorkbook 89 | Py.Exec "" & PythonCommand & "" 90 | Else 91 | ExecuteWindows False, PythonCommand, PYTHON_WIN, LOG_FILE, SHOW_LOG, PYTHONPATH 92 | End If 93 | #End If 94 | End Function 95 | 96 | Sub ExcecuteMac2011(PythonCommand As String, PYTHON_MAC As String, LOG_FILE As String, SHOW_LOG As Boolean, Optional PYTHONPATH As String) 97 | ' Run Python with the "-c" command line switch: add the path of the python file and run the 98 | ' Command as first argument, then provide the WORKBOOK_FULLNAME and "from_xl" as 2nd and 3rd arguments. 99 | ' Finally, redirect stderr to the LOG_FILE and run as background process. 100 | 101 | Dim PythonInterpreter As String, RunCommand As String, WORKBOOK_FULLNAME As String, Log As String 102 | Dim Res As Integer 103 | 104 | If LOG_FILE = "" Then 105 | LOG_FILE = "/tmp/xlwings_log.txt" 106 | Else 107 | LOG_FILE = ToPosixPath(LOG_FILE) 108 | End If 109 | 110 | ' Delete Log file just to make sure we don't show an old error 111 | On Error Resume Next 112 | KillFileOnMac ToMacPath(LOG_FILE) 113 | On Error GoTo 0 114 | 115 | ' Transform from MacOS Classic path style (":") and Windows style ("\") to Bash friendly style ("/") 116 | PYTHONPATH = ToPosixPath(PYTHONPATH) 117 | If PYTHON_MAC <> "" Then 118 | PythonInterpreter = ToPosixPath(PYTHON_MAC) 119 | Else 120 | PythonInterpreter = "python" 121 | End If 122 | WORKBOOK_FULLNAME = ToPosixPath(ThisWorkbook.Path & ":" & ThisWorkbook.Name) 'ThisWorkbook.FullName doesn't handle unicode on Excel 2011 123 | 124 | ' Build the command (ignore warnings to be in line with Windows where we only show the popup if the ExitCode <> 0 125 | ' -u is needed because on PY3 stderr is buffered by default and so wouldn't be available on time for the pop-up to show 126 | RunCommand = PythonInterpreter & " -u -B -W ignore -c ""import sys, os; sys.path.extend(os.path.normcase(os.path.expandvars(r'" & PYTHONPATH & "')).split(';')); " & PythonCommand & """ " 127 | 128 | ' Send the command to the shell. Courtesy of Robert Knight (http://stackoverflow.com/a/12320294/918626) 129 | ' Since Excel blocks AppleScript as long as a VBA macro is running, we have to excecute the call as background call 130 | ' so it can do its magic after this Function has terminated. Python calls ClearUp via the atexit handler. 131 | 132 | 'Check if .bash_profile is existing and source it 133 | Res = system("source ~/.bash_profile") 134 | If Res = 0 Then 135 | Res = system("source ~/.bash_profile;" & RunCommand & """" & WORKBOOK_FULLNAME & """ ""from_xl""" & " " & Chr(34) & ToPosixPath(Application.Path) & "/" & Application.Name & Chr(34) & ">" & Chr(34) & LOG_FILE & Chr(34) & " 2>&1 &") 136 | Else 137 | Res = system(RunCommand & """" & WORKBOOK_FULLNAME & """ ""from_xl""" & " " & Chr(34) & ToPosixPath(Application.Path) & "/" & Application.Name & Chr(34) & ">" & Chr(34) & LOG_FILE & Chr(34) & " 2>&1 &") 138 | End If 139 | 140 | ' If there's a log at this point (normally that will be from the Shell only, not Python) show it and reset the StatusBar 141 | On Error Resume Next 142 | Log = ReadFile(LOG_FILE) 143 | If Log = "" Then 144 | Exit Sub 145 | ElseIf SHOW_LOG = True Then 146 | ShowError (LOG_FILE) 147 | Application.StatusBar = False 148 | End If 149 | On Error GoTo 0 150 | End Sub 151 | 152 | Sub ExecuteMac(PythonCommand As String, PYTHON_MAC As String, LOG_FILE As String, SHOW_LOG As Boolean, Optional PYTHONPATH As String) 153 | 154 | Dim PythonInterpreter As String, RunCommand As String, WORKBOOK_FULLNAME As String, Log As String, ParameterString As String, ExitCode As String 155 | Dim Res As Integer 156 | 157 | ' Transform paths 158 | PYTHONPATH = ToPosixPath(PYTHONPATH) 159 | 160 | If PYTHON_MAC <> "" Then 161 | PythonInterpreter = ToPosixPath(PYTHON_MAC) 162 | Else 163 | PythonInterpreter = "python" 164 | End If 165 | 166 | WORKBOOK_FULLNAME = ToPosixPath(ThisWorkbook.FullName) 167 | If LOG_FILE = "" Then 168 | ' Sandbox location that requires no file access confirmation 169 | LOG_FILE = Environ("HOME") + "/xlwings_log.txt" '/Users//Library/Containers/com.microsoft.Excel/Data/xlwings_log.txt 170 | Else 171 | LOG_FILE = ToPosixPath(LOG_FILE) 172 | End If 173 | 174 | ' Delete Log file just to make sure we don't show an old error 175 | On Error Resume Next 176 | Kill LOG_FILE 177 | On Error GoTo 0 178 | 179 | ' ParameterSting with all paramters (AppleScriptTask only accepts a single parameter) 180 | ParameterString = PYTHONPATH + ";" 181 | ParameterString = ParameterString + "," + PythonInterpreter 182 | ParameterString = ParameterString + "," + PythonCommand 183 | ParameterString = ParameterString + "," + ThisWorkbook.FullName 184 | ParameterString = ParameterString + "," + Left(Application.Path, Len(Application.Path) - 4) 185 | ParameterString = ParameterString + "," + LOG_FILE 186 | 187 | On Error GoTo AppleScriptErrorHandler 188 | ExitCode = AppleScriptTask("xlwings.applescript", "VbaHandler", ParameterString) 189 | On Error GoTo 0 190 | 191 | ' If there's a log at this point (normally that will be from the Shell only, not Python) show it and reset the StatusBar 192 | On Error Resume Next 193 | Log = ReadFile(LOG_FILE) 194 | If Log = "" Then 195 | Exit Sub 196 | ElseIf SHOW_LOG = True Then 197 | ShowError (LOG_FILE) 198 | Application.StatusBar = False 199 | End If 200 | Exit Sub 201 | On Error GoTo 0 202 | 203 | AppleScriptErrorHandler: 204 | MsgBox "To enable RunPython, please run 'xlwings runpython install' in a terminal once and try again.", vbCritical 205 | 206 | End Sub 207 | 208 | Sub ExecuteWindows(IsFrozen As Boolean, PythonCommand As String, PYTHON_WIN As String, LOG_FILE As String, SHOW_LOG As Boolean, Optional PYTHONPATH As String) 209 | ' Call a command window and change to the directory of the Python installation or frozen executable 210 | ' Note: If Python is called from a different directory with the fully qualified path, pywintypesXX.dll won't be found. 211 | ' This seems to be a general issue with pywin32, see http://stackoverflow.com/q/7238403/918626 212 | 213 | Dim Wsh As Object 214 | Dim WaitOnReturn As Boolean: WaitOnReturn = True 215 | Dim WindowStyle As Integer: WindowStyle = 0 216 | Set Wsh = CreateObject("WScript.Shell") 217 | Dim DriveCommand As String, RunCommand As String, WORKBOOK_FULLNAME As String, PythonInterpreter As String, PythonDir As String 218 | Dim ExitCode As Integer 219 | 220 | If LOG_FILE = "" Then 221 | LOG_FILE = Environ("APPDATA") + "\xlwings_log.txt" 222 | End If 223 | 224 | If Not IsFrozen And PYTHON_WIN <> "" Then 225 | PythonDir = ParentFolder(PYTHON_WIN) 226 | Else 227 | PythonDir = PYTHON_WIN 228 | End If 229 | 230 | If Left$(PYTHON_WIN, 2) Like "[A-Za-z]:" Then 231 | ' If Python is installed on a mapped or local drive, change to drive, then cd to path 232 | DriveCommand = Left$(PYTHON_WIN, 2) & " & cd """ & PythonDir & """ & " 233 | ElseIf Left$(PYTHON_WIN, 2) = "\\" Then 234 | ' If Python is installed on a UNC path, temporarily mount and activate a drive letter with pushd 235 | DriveCommand = "pushd """ & PythonDir & """ & " 236 | End If 237 | 238 | ' Run Python with the "-c" command line switch: add the path of the python file and run the 239 | ' Command as first argument, then provide the WORKBOOK_FULLNAME and "from_xl" as 2nd and 3rd arguments. 240 | ' Then redirect stderr to the LOG_FILE and wait for the call to return. 241 | WORKBOOK_FULLNAME = ThisWorkbook.FullName 242 | 243 | If PYTHON_WIN <> "" Then 244 | PythonInterpreter = Chr(34) & PYTHON_WIN & Chr(34) 245 | Else 246 | PythonInterpreter = "python" 247 | End If 248 | 249 | If IsFrozen = False Then 250 | RunCommand = PythonInterpreter & " -B -c ""import sys, os; sys.path.extend(os.path.normcase(os.path.expandvars(r'" & PYTHONPATH & "')).split(';')); " & PythonCommand & """ " 251 | ElseIf IsFrozen = True Then 252 | RunCommand = PythonCommand & " " 253 | End If 254 | 255 | ExitCode = Wsh.Run("cmd.exe /C " & DriveCommand & _ 256 | RunCommand & _ 257 | """" & WORKBOOK_FULLNAME & """ ""from_xl""" & " " & Chr(34) & _ 258 | Application.Path & "\" & Application.Name & Chr(34) & " " & Chr(34) & Application.Hwnd & Chr(34) & _ 259 | " 2> """ & LOG_FILE & """ ", _ 260 | WindowStyle, WaitOnReturn) 261 | 262 | 'If ExitCode <> 0 then there's something wrong 263 | If ExitCode <> 0 And SHOW_LOG = True Then 264 | Call ShowError(LOG_FILE) 265 | End If 266 | 267 | ' Delete file after the error message has been shown 268 | On Error Resume Next 269 | Kill LOG_FILE 270 | On Error GoTo 0 271 | 272 | ' Clean up 273 | Set Wsh = Nothing 274 | End Sub 275 | 276 | Public Function RunFrozenPython(Executable As String) 277 | ' Runs a Python executable that has been frozen by cx_Freeze or py2exe. Call the function like this: 278 | ' RunFrozenPython("frozen_executable.exe"). Currently not implemented for Mac. 279 | 280 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String, LOG_FILE As String, UDF_MODULES As String 281 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 282 | Dim Res As Integer 283 | 284 | ' Get the settings by using the ByRef trick 285 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 286 | 287 | ' Call Python 288 | #If Mac Then 289 | MsgBox "This functionality is not yet supported on Mac." & vbNewLine & _ 290 | "Please run your scripts directly in Python!", vbCritical + vbOKOnly, "Unsupported Feature" 291 | #Else 292 | ExecuteWindows True, Executable, PYTHON_FROZEN, LOG_FILE, SHOW_LOG 293 | #End If 294 | End Function 295 | 296 | Function GetUdfModules() As String 297 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String 298 | Dim LOG_FILE As String, UDF_MODULES As String 299 | Dim Res As Integer 300 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 301 | 302 | ' Get the settings 303 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 304 | 305 | If UDF_MODULES = "" Then 306 | GetUdfModules = Left$(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) ' assume that it ends in .xlsm 307 | Else 308 | GetUdfModules = UDF_MODULES 309 | End If 310 | End Function 311 | 312 | Function ReadFile(ByVal FileName As String) 313 | ' Read a text file 314 | 315 | Dim Content As String 316 | Dim Token As String 317 | Dim FileNum As Integer 318 | Dim objShell As Object 319 | 320 | #If Mac Then 321 | FileName = ToMacPath(FileName) 322 | #Else 323 | Set objShell = CreateObject("WScript.Shell") 324 | FileName = objShell.ExpandEnvironmentStrings(FileName) 325 | #End If 326 | 327 | FileNum = FreeFile 328 | Content = "" 329 | 330 | ' Read Text File 331 | Open FileName For Input As #FileNum 332 | Do While Not EOF(FileNum) 333 | Line Input #FileNum, Token 334 | Content = Content & Token & vbCrLf 335 | Loop 336 | Close #FileNum 337 | 338 | ReadFile = Content 339 | End Function 340 | 341 | Sub ShowError(FileName As String) 342 | ' Shows a MsgBox with the content of a text file 343 | 344 | Dim Content As String 345 | Dim objShell 346 | 347 | Const OK_BUTTON_ERROR = 16 348 | Const AUTO_DISMISS = 0 349 | 350 | Content = ReadFile(FileName) 351 | #If Win32 Or Win64 Then 352 | Content = Content & vbCrLf 353 | Content = Content & "Press Ctrl+C to copy this message to the clipboard." 354 | 355 | Set objShell = CreateObject("Wscript.Shell") 356 | objShell.Popup Content, AUTO_DISMISS, "Error", OK_BUTTON_ERROR 357 | #Else 358 | MsgBox Content, vbCritical, "Error" 359 | #End If 360 | 361 | End Sub 362 | 363 | Function ToPosixPath(ByVal MacPath As String) As String 364 | 'This function accepts relative paths with backward and forward slashes: ThisWorkbook & "\test" 365 | ' E.g. "MacintoshHD:Users:" --> "/Users/" 366 | 367 | Dim s As String 368 | Dim LeadingSlash As Boolean 369 | 370 | If MacPath = "" Then 371 | ToPosixPath = "" 372 | Else 373 | #If MAC_OFFICE_VERSION < 15 Then 374 | If Left$(MacPath, 1) = "/" Then 375 | LeadingSlash = True 376 | End If 377 | MacPath = Replace(MacPath, "\", ":") 378 | MacPath = Replace(MacPath, "/", ":") 379 | s = "tell application " & Chr(34) & "Finder" & Chr(34) & Chr(13) 380 | s = s & "POSIX path of " & Chr(34) & MacPath & Chr(34) & Chr(13) 381 | s = s & "end tell" & Chr(13) 382 | If LeadingSlash = True Then 383 | ToPosixPath = "/" + MacScript(s) 384 | Else 385 | ToPosixPath = MacScript(s) 386 | End If 387 | If Left$(ToPosixPath, 2) = "/$" Then 388 | ' If it starts with an env variables, it's otherwise not correctly returned 389 | ToPosixPath = Right$(ToPosixPath, Len(ToPosixPath) - 1) 390 | End If 391 | 392 | #Else 393 | ToPosixPath = Replace(MacPath, "\", "/") 394 | #End If 395 | End If 396 | End Function 397 | 398 | Function GetMacDir(Name As String) As String 399 | ' Get Mac special folders. Protetcted so they don't exectue on Windows. 400 | 401 | Dim Path As String 402 | 403 | #If Mac Then 404 | Select Case Name 405 | Case "Home" 406 | Path = MacScript("return (path to home folder) as string") 407 | Case "Desktop" 408 | Path = MacScript("return (path to desktop folder) as string") 409 | Case "Applications" 410 | Path = MacScript("return (path to applications folder) as string") 411 | Case "Documents" 412 | Path = MacScript("return (path to documents folder) as string") 413 | End Select 414 | GetMacDir = Left$(Path, Len(Path) - 1) ' get rid of trailing ":" 415 | #Else 416 | GetMacDir = "" 417 | #End If 418 | End Function 419 | 420 | Function ToMacPath(PosixPath As String) As String 421 | ' This function transforms a Posix Path into a MacOS Path 422 | ' E.g. "/Users/" --> "MacintoshHD:Users:" 423 | 424 | ToMacPath = MacScript("set mac_path to POSIX file " & Chr(34) & PosixPath & Chr(34) & " as string") 425 | End Function 426 | 427 | Function KillFileOnMac(Filestr As String) 428 | 'Ron de Bruin 429 | '30-July-2012 430 | 'Delete files from a Mac. 431 | 'Uses AppleScript to avoid the problem with long file names (on 2011 only) 432 | 433 | Dim ScriptToKillFile As String 434 | 435 | ScriptToKillFile = "tell application " & Chr(34) & "Finder" & Chr(34) & Chr(13) 436 | ScriptToKillFile = ScriptToKillFile & "do shell script ""rm "" & quoted form of posix path of " & Chr(34) & Filestr & Chr(34) & Chr(13) 437 | ScriptToKillFile = ScriptToKillFile & "end tell" 438 | 439 | On Error Resume Next 440 | MacScript (ScriptToKillFile) 441 | On Error GoTo 0 442 | End Function 443 | 444 | Private Sub CleanUp() 445 | 'On Mac only, this function is being called after Python is done (using Python's atexit handler) 446 | 447 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String, UDF_MODULES As String 448 | Dim WORKBOOK_FULLNAME As String, LOG_FILE As String 449 | Dim Res As Integer 450 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 451 | 452 | 'Get LOG_FILE 453 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 454 | 455 | If LOG_FILE = "" Then 456 | #If MAC_OFFICE_VERSION >= 15 Then 457 | LOG_FILE = Environ("HOME") + "/xlwings_log.txt" '/Users//Library/Containers/com.microsoft.Excel/Data/xlwings_log.txt 458 | #Else 459 | LOG_FILE = "/tmp/xlwings_log.txt" 460 | #End If 461 | Else 462 | LOG_FILE = ToPosixPath(LOG_FILE) 463 | End If 464 | 465 | 'Show the LOG_FILE as MsgBox if not empty 466 | If SHOW_LOG = True Then 467 | On Error Resume Next 468 | If ReadFile(LOG_FILE) <> "" Then 469 | Call ShowError(LOG_FILE) 470 | End If 471 | On Error GoTo 0 472 | End If 473 | 474 | 'Clean up 475 | Application.StatusBar = False 476 | Application.ScreenUpdating = True 477 | On Error Resume Next 478 | #If MAC_OFFICE_VERSION >= 15 Then 479 | Kill LOG_FILE 480 | #Else 481 | KillFileOnMac ToMacPath(ToPosixPath(LOG_FILE)) 482 | #End If 483 | On Error GoTo 0 484 | End Sub 485 | 486 | Function ParentFolder(ByVal Folder) 487 | ParentFolder = Left$(Folder, InStrRev(Folder, "\") - 1) 488 | End Function 489 | 490 | Function XLPyCommand() 491 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String 492 | Dim LOG_FILE As String, UDF_MODULES As String, Tail As String 493 | Dim Res As Integer 494 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 495 | 496 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 497 | 498 | If UDF_DEBUG_SERVER = True Then 499 | XLPyCommand = "{506e67c3-55b5-48c3-a035-eed5deea7d6d}" 500 | Else 501 | Tail = " -B -c ""import sys, os;sys.path.extend(os.path.normcase(os.path.expandvars(r'" & PYTHONPATH & "')).split(';'));import xlwings.server; xlwings.server.serve('$(CLSID)')""" 502 | If PYTHON_WIN = "" Then 503 | XLPyCommand = "pythonw.exe" + Tail 504 | Else 505 | XLPyCommand = PYTHON_WIN + Tail 506 | End If 507 | End If 508 | End Function 509 | 510 | Private Sub XLPyLoadDLL() 511 | Dim PYTHON_WIN As String, PYTHON_MAC As String, PYTHON_FROZEN As String, PYTHONPATH As String 512 | Dim LOG_FILE As String, UDF_MODULES As String, Tail As String 513 | Dim Res As Integer 514 | Dim SHOW_LOG As Boolean, OPTIMIZED_CONNECTION As Boolean, UDF_DEBUG_SERVER As Boolean 515 | 516 | Res = Settings(PYTHON_WIN, PYTHON_MAC, PYTHON_FROZEN, PYTHONPATH, UDF_MODULES, UDF_DEBUG_SERVER, LOG_FILE, SHOW_LOG, OPTIMIZED_CONNECTION) 517 | 518 | If PYTHON_WIN <> "" Then 519 | If LoadLibrary(ParentFolder(PYTHON_WIN) + "\" + XLPyDLLName) = 0 Then ' Standard installation 520 | If LoadLibrary(ParentFolder(ParentFolder(PYTHON_WIN)) + "\" + XLPyDLLName) = 0 Then ' Virtualenv 521 | Err.Raise 1, Description:= _ 522 | "Could not load " + XLPyDLLName + " from either of the following folders: " _ 523 | + vbCrLf + ParentFolder(PYTHON_WIN) _ 524 | + vbCrLf + ", " + ParentFolder(ParentFolder(PYTHON_WIN)) 525 | End If 526 | End If 527 | End If 528 | End Sub 529 | 530 | Function NDims(ByRef src As Variant, dims As Long, Optional transpose As Boolean = False) 531 | XLPyLoadDLL 532 | If 0 <> XLPyDLLNDims(src, dims, transpose, NDims) Then Err.Raise 1001, Description:=NDims 533 | End Function 534 | 535 | Function Py() 536 | XLPyLoadDLL 537 | If 0 <> XLPyDLLActivateAuto(Py, XLPyCommand) Then Err.Raise 1000, Description:=Py 538 | End Function 539 | 540 | Private Sub GetDLLVersion() 541 | ' Currently only for testing 542 | Dim tag As String, arch As String 543 | Dim ver As Double 544 | XLPyDLLVersion tag, ver, arch 545 | Debug.Print tag 546 | Debug.Print ver 547 | Debug.Print arch 548 | End Sub 549 | 550 | Sub ImportPythonUDFs() 551 | Dim tempPath As String 552 | tempPath = Py.Str(Py.Call(Py.Module("xlwings"), "import_udfs", Py.Tuple(GetUdfModules, ThisWorkbook))) 553 | End Sub 554 | -------------------------------------------------------------------------------- /sys_plugin/data_structure/stack.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/data_structure/stack.cls -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/EditOperation.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "EditOperation" 2 | Sub InteriorColor(number) '{{{ 3 | Selection.Interior.ColorIndex = number 4 | End Sub '}}} 5 | 6 | Sub FontColor(number) '{{{ 7 | Debug.Print "FontColor" 8 | Selection.Font.ColorIndex = number 9 | End Sub '}}} 10 | 11 | Sub SetRuledLines() '{{{ 12 | Selection.Borders.LineStyle = xlContinuous 13 | End Sub '}}} 14 | 15 | Sub UnsetRuledLines() '{{{ 16 | Selection.Borders.LineStyle = xlLineStyleNone 17 | End Sub '}}} 18 | 19 | Sub merge() '{{{ 20 | Selection.merge 21 | End Sub '}}} 22 | 23 | Sub unmerge() '{{{ 24 | Selection.unmerge 25 | End Sub '}}} 26 | 27 | Sub ex_up() '{{{ 28 | Application.ScreenUpdating = False 29 | cur_row = ActiveCell.Row 30 | Rows(cur_row).Copy 31 | 'select target_row 32 | Dim i As Long 33 | i = 1 34 | Do Until ActiveCell.Offset(-i, 0).EntireRow.Hidden = False 35 | i = i + 1 36 | Loop 37 | target_row = ActiveCell.Offset(-i, 0).Row 38 | target_column = ActiveCell.Offset(-i, 0).Column 39 | 40 | Rows(target_row).Select 41 | Selection.Insert 42 | 43 | ' remove the cell before moving 44 | Rows(cur_row + 1).Delete 45 | cells(target_row, target_column).Select 46 | End Sub '}}} 47 | 48 | Sub ex_below() '{{{ 49 | Application.ScreenUpdating = False 50 | cur_row = ActiveCell.Row 51 | Rows(cur_row).Copy 52 | 'target_row�̑I�� 53 | Dim i As Long 54 | i = 1 55 | Do Until ActiveCell.Offset(i, 0).EntireRow.Hidden = False 56 | i = i + 1 57 | Loop 58 | target_row = ActiveCell.Offset(i, 0).Row 59 | target_column = ActiveCell.Offset(i, 0).Column 60 | 61 | Rows(target_row + 1).Select 62 | Selection.Insert 63 | Rows(cur_row).Delete 64 | 65 | cells(target_row, target_column).Select 66 | End Sub '}}} 67 | 68 | Sub ex_right() '{{{ 69 | Application.ScreenUpdating = False 70 | cur_col = ActiveCell.Column 71 | Columns(cur_col).Copy 72 | 'select target_row 73 | Dim i As Long 74 | i = 1 75 | Do Until ActiveCell.Offset(0, i).EntireColumn.Hidden = False 76 | i = i + 1 77 | Loop 78 | target_row = ActiveCell.Offset(0, i).Row 79 | target_column = ActiveCell.Offset(0, i).Column 80 | 81 | Columns(target_column + 1).Select 82 | Selection.Insert 83 | Columns(cur_col).Delete 84 | 85 | cells(target_row, target_column).Select 86 | End Sub '}}} 87 | 88 | Sub ex_left() '{{{ 89 | Application.ScreenUpdating = False 90 | cur_col = ActiveCell.Column 91 | Columns(cur_col).Copy 92 | 'select target_row 93 | Dim i As Long 94 | i = 1 95 | Do Until ActiveCell.Offset(0, -i).EntireColumn.Hidden = False 96 | i = i + 1 97 | Loop 98 | target_row = ActiveCell.Offset(0, -i).Row 99 | target_column = ActiveCell.Offset(0, -i).Column 100 | 101 | Columns(target_column).Select 102 | Selection.Insert 103 | Columns(cur_col + 1).Delete 104 | 105 | cells(target_row, target_column).Select 106 | End Sub '}}} 107 | 108 | Sub ZoomInWindow() '{{{ 109 | ActiveWindow.Zoom = ActiveWindow.Zoom + 5 110 | End Sub '}}} 111 | 112 | Sub ZoomOutWindow() '{{{ 113 | ActiveWindow.Zoom = ActiveWindow.Zoom - 5 114 | End Sub '}}} 115 | 116 | Sub MouseNormal() '{{{ 117 | Application.Cursor = xlDefault 118 | End Sub '}}} 119 | 120 | Sub SetSeqNumber(Optional destRange As Range = Nothing) '{{{ 121 | Application.ScreenUpdating = False 122 | If destRange Is Nothing Then 123 | Set destRange = Selection 124 | End If 125 | Set destRange = destRange.SpecialCells(xlCellTypeVisible) 126 | n = 1 127 | For Each r In destRange 128 | r.value = n 129 | Selection.NumberFormatLocal = "0_);[��](0)" 130 | n = n + 1 131 | Next 132 | End Sub '}}} 133 | 134 | Sub SortCurrentColumn() '{{{ 135 | Application.ScreenUpdating = False 136 | Set targetRange = Selection.CurrentRegion 137 | 138 | With ActiveSheet.Sort 139 | With .SortFields 140 | .Clear 141 | .Add _ 142 | Key:=Columns(ActiveCell.Column), _ 143 | SortOn:=xlSortOnValues, _ 144 | Order:=xlAscending, _ 145 | DataOption:=xlSortNormal 146 | End With 147 | .SetRange targetRange 148 | .Header = xlYes 'check header exists. xlGuess rely on Excel. 149 | .MatchCase = False 150 | .Orientation = xlTopToBottom 151 | .SortMethod = xlPinYin 152 | .Apply 153 | End With 154 | End Sub '}}} 155 | 156 | '--------sheet_move------------------- 157 | Sub ActivateLeftSheet() '{{{ 158 | sendkeys "^{PGUP}" 159 | End Sub '}}} 160 | 161 | Sub ActivateRightSheet() '{{{ 162 | sendkeys "^{PGDN}" 163 | End Sub '}}} 164 | 165 | Sub ActivateFirstSheet(Optional where As String) '{{{ 166 | With ActiveWorkbook 167 | .WorkSheets(1).Activate 168 | End With 169 | End Sub '}}} 170 | 171 | Sub ActivateLastSheet(Optional where As String) '{{{ 172 | With ActiveWorkbook 173 | .WorkSheets(.WorkSheets.Count).Activate 174 | End With 175 | End Sub '}}} 176 | 177 | '---------auto_filter----------------- 178 | Sub focusFromScratch() '{{{ 179 | Application.ScreenUpdating = False 180 | If ActiveSheet.FilterMode Then 181 | ActiveSheet.ShowAllData 182 | End If 183 | GetFilterRange.AutoFilter ActiveCell.Column - GetFilterRange.Column + 1, ActiveCell.Value 184 | End Sub '}}} 185 | 186 | Sub focus() '{{{ 187 | Application.ScreenUpdating = False 188 | GetFilterRange.AutoFilter ActiveCell.Column - GetFilterRange.Column + 1, ActiveCell.Value 189 | End Sub '}}} 190 | 191 | Sub exclude()'{{{ 192 | Application.ScreenUpdating = False 193 | Dim filterCondition As Variant 194 | Dim buf As String 195 | 196 | buf = cells(ActiveCell.Row ,ActiveCell.Column).value 197 | 198 | Debug.Print Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row 199 | Set targetColumnRange = InterSect(GetFilterRange, Columns(ActiveCell.Column)) 200 | Set targetColumnRange = targetColumnRange.SpecialCells(xlCellTypeVisible) 201 | 202 | Set showedValueCollection = CreateObject("Scripting.Dictionary") 203 | On Error Resume Next 204 | For Each c in targetColumnRange 205 | If c.Value <> buf Then 206 | showedValueCollection.Add "_" & c.Value, c.Value 207 | End If 208 | Next c 209 | On Error GoTo 0 210 | 211 | filterCondition = showedValueCollection.Keys 212 | 213 | For e = 0 to Ubound(filterCondition) 214 | filterCondition(e) = Mid(filterCondition(e),2) 215 | Next e 216 | 217 | GetFilterRange.AutoFilter field:= ActiveCell.Column - GetFilterRange.Column + 1, Criteria1:=filterCondition, Operator:=xlFilterValues 218 | End Sub'}}} 219 | 220 | Sub filterOff() '{{{ 221 | Application.ScreenUpdating = False 222 | GetFilterRange.AutoFilter ActiveCell.Column 223 | End Sub '}}} 224 | 225 | Function GetFilterRange() As Range'{{{ 226 | On Error GoTo error 227 | Set GetFilterRange = ActiveSheet.AutoFilter.Range 228 | Exit Function 229 | error: 230 | Set GetFilterRange = ActiveSheet.UsedRange 231 | End Function'}}} 232 | 233 | Function smallerFonts() '{{{ 234 | Dim currentFontSize As Long 235 | On Error GoTo ERROR01 236 | currentFontSize = Selection.Font.Size 237 | Selection.Font.Size = currentFontSize - 1 238 | period_buff = ">" 239 | ERROR01: 240 | End Function '}}} 241 | 242 | Function biggerFonts() '{{{ 243 | Dim currentFontSize As Long 244 | On Error GoTo ERROR01 245 | currentFontSize = Selection.Font.Size 246 | Selection.Font.Size = currentFontSize + 1 247 | period_buff = "<" 248 | ERROR01: 249 | End Function '}}} 250 | 251 | Sub sp(Optional clearFilterdRowValue = 0) '{{{ smartpaste 252 | 'TODO: erase data source 253 | 254 | Application.ScreenUpdating = False 255 | 256 | 'need Microsoft Forms 2.0 Object Library reference 257 | Dim V As Variant 'whole data on clipboard 258 | Dim A As Variant 'one line 259 | 260 | 261 | Set destRange = Range(ActiveCell, cells(Rows.count, ActiveCell.Column)) 'ActiveCell to last row 262 | Set destRange = destRange.SpecialCells(xlCellTypeVisible) 'get visible cells only 263 | 264 | ''{{{ 265 | Dim Dobj As DataObject 266 | Set Dobj = New DataObject 267 | With Dobj 268 | .GetFromClipboard 269 | On Error Resume Next 270 | V = .GetText 271 | On Error GoTo 0 272 | End With'}}} 273 | 274 | If Not IsEmpty(V) Then 275 | V = Split(CStr(V), vbCrLf) 276 | 277 | 'erase lines hided by filter '{{{ 278 | If clearFilterdRowValue = 1 Then 279 | referencRangeHeight = UBound(V) + 1 280 | referencRangeWidth = UBound(Split(CStr(V(0)), vbTab)) + 1 281 | Debug.Print referencRangeHeight 282 | Debug.Print referencRangeWidth 283 | For Each c in ActiveCell.Resize(referencRangeHeight, referencRangeWidth) 284 | c.Value = "" 285 | Next c 286 | End If'}}} 287 | 288 | 'TODO: delete source data 289 | If Application.CutCopyMode = xlCut Then 290 | Set srcRange = GetCopiedRange(ActiveSheet.Name) 291 | For Each c in srcRange 292 | c.Value = "" 293 | Next c 294 | 295 | Application.CutCopyMode = False 296 | End If 297 | 298 | '{{{ 299 | Dim i As Integer: i = 0 300 | Dim r As Range 301 | For Each r In destRange 302 | A = Split(CStr(V(i)), vbTab) 'i line 303 | For j = 0 to Ubound(A) 304 | If Cstr(Val(A(j))) = A(j) Then 305 | r.Offset(0, j).Value = Val(A(j)) 306 | Else 307 | r.Offset(0, j).Value = A(j) 308 | End If 309 | Next j 310 | If Ubound(A) = -1 Then 311 | r.Offset(0, j).Value = "" 312 | End If 313 | 314 | i = i + 1 315 | If i >= UBound(V) Then 316 | Exit For 317 | End If 318 | Next'}}} 319 | End If 320 | 321 | Set Dobj = Nothing 322 | Set r = Nothing 323 | End Sub '}}} 324 | 325 | Sub sp2() '{{{ smartpaste 326 | Set srcRange = GetCopiedRange(ActiveSheet.Name) 327 | For Each r in srcRange.Rows 328 | Debug.Print r.row 329 | Next r 330 | End Sub '}}} 331 | 332 | Sub num_format_million() 333 | Selection.NumberFormatLocal = "#,##0,," 334 | End Sub 335 | 336 | Sub topleft() 337 | Dim backsh As worksheet 338 | Set backsh = ActiveSheet 339 | For Each ws In ActiveWorkbook.Worksheets 340 | ws.Activate 341 | Range("A1").Select 342 | Next ws 343 | backsh.Activate 344 | End Sub 345 | 346 | '---------diff----------------- 347 | Sub diffsh(targetsh As Worksheet, fromsh As Worksheet)'{{{ 348 | 'TODO prompt 349 | For Each c in fromsh.UsedRange 350 | If c.Value <> targetsh.Cells(c.Row, c.Column).Value Then 351 | targetsh.Cells(c.Row, c.Column).Interior.ColorIndex = 29 352 | End If 353 | Next c 354 | End Sub'}}} 355 | 356 | Sub diffRange(targetRange As Range, fromRange As Range)'{{{ 357 | 'TODO 358 | End Sub'}}} 359 | 360 | '-----------Supplimental functions------------------------ 361 | Function Field_No(fieldName As String, Optional sheetName As String = "", Optional fieldRowNum As Long = 1)'{{{ 362 | If sheetName = "" Then 363 | set sheet = ActiveSheet 364 | Else 365 | set sheet = Worksheets(sheetName) 366 | End If 367 | 368 | Field_No = sheet.Range(Cells(fieldRowNum,1),Cells(fieldRowNum,50)).Find(What:=fieldName, LookIn:=xlFormulas, LookAt _ 369 | :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 370 | False, MatchByte:=False, SearchFormat:=False).Column 371 | End Function'}}} 372 | 373 | Function GroupNo(groupName as String)'{{{ 374 | GroupNo = ActiveSheet.Columns("A:A").Find(What:=groupName, LookIn:=xlFormulas, LookAt _ 375 | :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 376 | False, MatchByte:=False, SearchFormat:=False).Row 377 | End Function'}}} 378 | 379 | Function AlphabetColumn(num As Long)'{{{ 380 | buf = Cells(1, num).Address(True, False) 381 | AlphabetColumn = Left(buf, InStr(buf, "$") - 1) 382 | End Function'}}} 383 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/FileOperation.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "FileOperation" 2 | 'Option Explicit 3 | 4 | 'File operation 5 | Sub w(Optional fileName As String = "") '{{{ 6 | If fileName = "" Then 7 | Set wb = ActiveWorkbook 8 | Else 9 | Set wb = Workbooks(fileName) 10 | End If 11 | wb.Save 12 | End Sub '}}} 13 | Sub wa() '{{{ 14 | For Each wb In Workbooks 15 | wb.Save 16 | Next 17 | End Sub '}}} 18 | 19 | Sub q(Optional fileName As String = "") '{{{ 20 | If fileName = "" Then 21 | Set wb = ActiveWorkbook 22 | Else 23 | Set wb = Workbooks(fileName) 24 | End If 25 | wb.Close 26 | 27 | If Workbooks.count <= 1 Then 28 | On Error Resume Next 29 | Workbooks("register.xlsx").Close savechanges:=True 30 | Application.quit 31 | End If 32 | 33 | End Sub '}}} 34 | Sub q_exclamation() '{{{ 35 | Set atwb = ActiveWorkbook 36 | atwb.Close savechanges:=False 37 | 38 | If Workbooks.count <= 1 Then 39 | On Error Resume Next 40 | Workbooks("register.xlsx").Close savechanges:=True 41 | Application.quit 42 | End If 43 | End Sub '}}} 44 | Sub qa() '{{{ 45 | For Each Wb In Workbooks 46 | Wb.Close 47 | Next 48 | 49 | If Workbooks.count <= 1 Then 50 | On Error Resume Next 51 | Workbooks("register.xlsx").Close savechanges:=True 52 | Application.quit 53 | End If 54 | End Sub '}}} 55 | Sub qa_exclamation() '{{{ 56 | For Each Wb In Workbooks 57 | Wb.Close savechanges:=False 58 | Next 59 | If Workbooks.count = 0 Then 60 | Application.quit 61 | End If 62 | End Sub '}}} 63 | 64 | Sub wq(Optional fileName As String = "") '{{{ 65 | Call w(fileName) 66 | Call q(fileName) 67 | End Sub '}}} 68 | 69 | Sub cos() '{{{ 70 | Set atwb = ActiveWorkbook 71 | Workbooks.CheckOut (atwb.Path & "\" & atwb.Name) 72 | atwb.Save 73 | atwb.CheckIn 'include closing 74 | If Workbooks.count = 0 Then 75 | Application.quit 76 | End If 77 | End Sub '}}} 78 | 79 | Sub co() '{{{ 80 | Set atwb = ActiveWorkbook 81 | Workbooks.CheckOut (atwb.Path & "\" & atwb.Name) 82 | End Sub '}}} 83 | 84 | Function Path() '{{{ 85 | MsgBox ActiveWorkbook.Path 86 | Dim buf As String 87 | buf = ActiveWorkbook.Path 88 | SetStrToClipBoard(buf) 89 | End Function '}}} 90 | 91 | Function fpath() '{{{ 92 | Dim AWF As String 93 | AWF = ActiveWorkbook.FullName 94 | SetStrToClipBoard(AWF) 95 | MsgBox AWF 96 | End Function '}}} 97 | 98 | Function af() '{{{ 99 | ActiveCell.EntireColumn.Autofit 100 | ActiveCell.EntireRow.Autofit 101 | End Function '}}} 102 | 103 | Sub cd(Optional bookName = "") '{{{ 104 | If bookName = "" Then 105 | Set book = ActiveWorkbook 106 | Else 107 | Set book = Workbooks(bookName) 108 | End If 109 | 110 | On Error GoTo MyError 111 | If Left(book.FullName, 2) <> "\\" And Left(book.FullName, 2) <> "ht" Then 112 | ChDrive book.Path 113 | ChDir book.Path 114 | Else 115 | CreateObject("WScript.Shell").CurrentDirectory = book.Path 116 | End If 117 | 118 | Debug.Print "moved to " & Curdir 119 | Exit Sub 120 | MyError: 121 | MsgBox "failed cd " & "\n" & Err.Description 122 | End Sub '}}} 123 | 124 | Sub update() '{{{ 125 | If Not ActiveSheet.AutoFilter Is Nothing Then 126 | ActiveSheet.AutoFilter.ApplyFilter 127 | End If 128 | ActiveSheet.Calculate 129 | End Sub '}}} 130 | 131 | Public Function SmartOpenBook(filePath) '{{{ 132 | Dim buf As String, Wb As Workbook 133 | 134 | On Error Goto Myerror 135 | buf = dir(filePath) 136 | If buf = "" Then 137 | MsgBox filePath & vbCrLf & " not found", vbExclamation 138 | Exit Function 139 | End If 140 | 141 | 'check same name book 142 | For Each Wb In Workbooks 143 | If Wb.FullName = filePath Then 144 | Wb.Activate 145 | Exit Function 146 | End If 147 | Next Wb 148 | 149 | DoEvents 150 | ' Workbooks.Open FileName:=filePath, Notify:=True, AddToMru:=True 151 | CreateObject("Wscript.Shell").Run Chr(34) & filePath & Chr(34), 5 152 | 153 | Exit Function 154 | Myerror: 155 | MsgBox Err.Description & vbCrLf & "Alternatively filepath was copied to clipboard" 156 | SetStrToClipBoard(filePath) 157 | End Function '}}} 158 | 159 | 'PDF copy 160 | Public Sub PrintPdfDir(dirPath As String) '{{{ 161 | Dim FileName As String 162 | Dim fileList As New Collection 163 | FileName = dir(dirPath) 164 | Do While FileName <> "" 165 | fileList.Add Item:=dirPath & FileName 166 | FileName = dir 167 | Loop 168 | On Error GoTo err 169 | For Each f In fileList 170 | AdobeReader.PrintPdf FilePath:=CStr(f) 171 | Next f 172 | Exit Sub 173 | err: 174 | MsgBox err.number & vbCr & err.Description, vbCritical 175 | End Sub '}}} 176 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/custom_pivot.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "custom_pivot" 2 | 3 | Public sub setdefaultprop() 4 | Dim PT As PivotTable 5 | Set PT = ActiveCell.PivotTable 6 | PT.HasAutoFormat = False 7 | For Each f In PT.PivotFields 8 | f.ShowAllItems = True 9 | Next f 10 | End Sub 11 | 12 | Public sub numberformat() 13 | Dim PT As PivotTable 14 | Set PT = ActiveCell.PivotTable 15 | For Each f In PT.DataFields 16 | f.NumberFormat = "#,##0,," 17 | Next f 18 | End Sub 19 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/fold.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "fold" 2 | 3 | Sub Expand_All() 4 | ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8 5 | End Sub 6 | 7 | Sub Collapse_All() 8 | ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1 9 | End Sub -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/forSelection.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "forSelection" 2 | ' 3 | Sub dfs() 'doforeslection 4 | Dim c As Range 5 | For Each c In Selection 6 | Call dealing(c) 7 | Next c 8 | End Sub 9 | 10 | Private Sub dealing(ByRef c As Range) 11 | 'Write down process for each cell 12 | c.Value = "'" & CStr(c.Value) 13 | End Sub 14 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/formula_parser.bas: -------------------------------------------------------------------------------- 1 | attribute vb_name = "formula_parser" 2 | 3 | public sub format_current_cell() 4 | dim formula as string 5 | dim res as string 6 | formula = activecell.formula 7 | if mid(formula, 1, 1) <> "=" then 8 | msgbox "active cell is not formula." 9 | exit sub 10 | else 11 | res = format(formula) 12 | Set UniteCandidatesList = GatherCandidates_formula(res) 13 | unite_source = "formula" 14 | UniteInterface.Show 15 | 16 | ' msgbox res 17 | SetStrToClipBoard(res) 18 | ' activecell.formula = format(formula) 19 | end if 20 | end sub 21 | 22 | Function GatherCandidates_formula(arg As string) As Collection 23 | Dim lines As New Collection 24 | Dim line as string 25 | for idx = 1 to len(arg) 26 | char = mid(arg, idx, 1) 27 | if char = VBLF then 28 | lines.Add line 29 | line = "" 30 | else 31 | line = line & char 32 | end if 33 | Next 34 | lines.Add line 35 | Set GatherCandidates_formula = lines 36 | End Function 37 | 38 | Private Sub defaultAction_formula(arg As String) 39 | On Error GoTo Err 40 | Dim target as Range 41 | Set target = Range(convert_to_jumpable(arg)) 42 | Finally: 43 | On Error Resume Next 44 | Application.Goto Reference:=target 45 | Exit Sub 46 | Err: 47 | msgbox "The line you selected is not valid range to jump" 48 | End Sub 49 | 50 | Private Function convert_to_jumpable(arg As String) As String 51 | arg = Trim(arg) 52 | arg = Replace(arg, ",", "") 53 | arg = Replace(arg, """", "") 54 | convert_to_jumpable = arg 55 | End Function 56 | 57 | public sub resolve_current_cell() 58 | dim formula as string 59 | dim res as string 60 | formula = activecell.formula 61 | if mid(formula, 1, 1) <> "=" then 62 | msgbox "active cell is not formula." 63 | exit sub 64 | else 65 | res = resolve(format(formula)) 66 | Set UniteCandidatesList = GatherCandidates_formula(res) 67 | unite_source = "formula" 68 | UniteInterface.Show 69 | ' msgbox res 70 | SetStrToClipBoard(res) 71 | ' activecell.formula = format(formula) 72 | end if 73 | end sub 74 | 75 | private function format(formula as string) 76 | dim res as string: res = "" 77 | dim level as long: level = 0 78 | dim c as string 79 | dim idx as integer 80 | dim indent_string as string: indent_string = "" 81 | dim one_indent_size as long: one_indent_size = 4 82 | dim is_in_quotation as boolean: is_in_quotation = False 83 | 84 | for idx = 1 to len(formula) 85 | c = mid(formula, idx, 1) 86 | if (c <> VBLF) then 87 | if (c = """" and not is_in_quotation) then 88 | is_in_quotation = true 89 | res = res & c 90 | elseif (c = """" and is_in_quotation) then 91 | is_in_quotation = false 92 | res = res & c 93 | elseif (c = " " and is_in_quotation) then 94 | res = res & c 95 | elseif (c = " " and not is_in_quotation) then 96 | 97 | elseif (c = "(") then 98 | res = res & c 99 | level = level + 1 100 | indent_string = indent_string & " " 101 | res = res & VBLF 102 | res = res & indent_string 103 | elseif (c = ")") then 104 | level = level - 1 105 | indent_string = mid(indent_string, 1, len(indent_string) - one_indent_size) 106 | res = res & VBLF 107 | res = res & indent_string 108 | res = res & c 109 | level = level + 1 110 | elseif (c = ",") then 111 | res = res & c 112 | res = res & VBLF 113 | res = res & indent_string 114 | elseif (c = "=" and idx = 1) then 115 | res = res & c 116 | res = res & VBLF 117 | else 118 | res = res & c 119 | end if 120 | end if 121 | next 122 | 123 | format = res 124 | end function 125 | 126 | private function resolve(formula as string) 127 | ' assume formula is formatted 128 | dim res as string: res = "" 129 | dim c as string 130 | dim idx as integer 131 | dim line as string: line = "" 132 | dim indent_string as string: indent_string = "" 133 | dim to_resolve as boolean: to_resolve = true 134 | 135 | for idx = 1 to len(formula) 136 | c = mid(formula, idx, 1) 137 | if (c = " ") then 138 | indent_string = indent_string & " " 139 | elseif (c = VBLF) then 140 | dim prec as string: prec = mid(formula, idx-1, 1) 141 | if prec <> "," and prec <> "=" then 142 | if to_resolve then 143 | line = mod_evaluate(line) 144 | end if 145 | elseif prec = "," then 146 | if to_resolve then 147 | line = mid(line, 1, len(line)-1) 148 | line = mod_evaluate(line) 149 | line = line & "," 150 | end if 151 | end if 152 | 153 | res = res & indent_string & line & VBLF 154 | line = "" 155 | indent_string = "" 156 | to_resolve = true 157 | else 158 | if (c = "(" or c = ")") then 159 | to_resolve = false 160 | end if 161 | line = line & c 162 | end if 163 | next 164 | 165 | resolve = res & line 166 | end function 167 | 168 | private function mod_evaluate(line as string) 169 | on error goto asis 170 | if vartype(evaluate(line)) = 8 then ' 8 -> string 171 | line = chr(34) & evaluate(line) & chr(34) 172 | else 173 | line = chr(34) & evaluate(line) & chr(34) 174 | line = cstr(evaluate(line)) 175 | end if 176 | asis: 177 | mod_evaluate = line 178 | end function -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/ktHolidayName.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/miscellaneous/ktHolidayName.bas -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/make_value_paste_file.bas: -------------------------------------------------------------------------------- 1 | 2 | Attribute VB_Name = "make_value_paste_file" 3 | 4 | Sub make_value_paste_file_for_activeworkbook() 5 | make_value_paste_file ActiveWorkbook 6 | End Sub 7 | 8 | Sub make_value_paste_file(Optional wb As Workbook) 9 | Dim fso As FileSystemObject 10 | Set fso = New FileSystemObject 11 | Dim org As Long 12 | org = Application.Calculation 13 | Application.Calculation = xlCalculationManual 14 | For Each ws In wb.Worksheets 15 | ws.UsedRange.Value = ws.UsedRange.Value 16 | Next ws 17 | Application.Calculation = org 18 | wb.SaveAs fileName:=wb.Path & "\" & fso.GetBaseName(wb.name) & "_value.xlsx", FileFormat:=xlOpenXMLWorkbook 19 | End Sub 20 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/sheet_filter.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "sheet_filter" 2 | 3 | Sub filter_sheet() 4 | ' TODO: parameteraize 5 | For Each ws In Worksheets 6 | If InStr(ws.Name, "2019") = 0 Then 7 | Worksheets(ws.Name).Visible = False 8 | End If 9 | Next ws 10 | End Sub 11 | 12 | Sub show_all_sheet() 13 | For Each ws In Worksheets 14 | Worksheets(ws.Name).Visible = True 15 | Next ws 16 | End Sub 17 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/tmp.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "tmp" 2 | 3 | ' sandbox 4 | Sub RandomNumbers() 5 | RunPython ("import mymodule; mymodule.rand_numbers()") 6 | End Sub 7 | 8 | Sub temptemp() 9 | 10 | End Sub 11 | -------------------------------------------------------------------------------- /sys_plugin/miscellaneous/utility.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "utility" 2 | 3 | Public Sub SetStrToClipBoard(ByVal str As String) 4 | With CreateObject("Forms.TextBox.1") 5 | .MultiLine = True 6 | .Text = str 7 | .SelStart = 0 8 | .SelLength = .TextLength 9 | .Copy 10 | End With 11 | End Sub -------------------------------------------------------------------------------- /sys_plugin/vim/copyRange.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "copyRange" 2 | 3 | Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 4 | Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long 5 | Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long 6 | Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long 7 | Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long 8 | Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 9 | Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) 10 | Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long 11 | Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long 12 | 13 | '** 14 | ' get copy address 15 | '** 16 | Public Function GetCopiedRange(SheetName As String) As Range 17 | Dim i As Long 18 | Dim Format As Long 19 | Dim hMem As Long 20 | Dim p As Long 21 | Dim Data() As Byte 22 | Dim Size As Long 23 | Dim Address As String 24 | 25 | Call OpenClipboard(0) 26 | hMem = GetClipboardData(RegisterClipboardFormat("Link")) 27 | If hMem = 0 Then 28 | Call CloseClipboard 29 | Exit Function 30 | End If 31 | 32 | Size = GlobalSize(hMem) 33 | p = GlobalLock(hMem) 34 | ReDim Data(0 To Size - 1) 35 | Call MoveMemory(VarPtr(Data(0)), p, Size) 36 | Call GlobalUnlock(hMem) 37 | 38 | Call CloseClipboard 39 | 40 | For i = 0 To Size - 1 41 | If Data(i) = 0 Then 42 | Data(i) = Asc(" ") 43 | End If 44 | Next i 45 | 46 | Dim buf As String 47 | buf = Trim(AnsiToUnicode(Data())) 48 | Address = Right(buf, InStr(StrReverse(buf), " ") - 1) 49 | 50 | Set GetCopiedRange = Range(Application.ConvertFormula(Address, xlR1C1, xlA1)) 51 | End Function 52 | 53 | '** 54 | ' convert unicode 55 | '** 56 | Private Function AnsiToUnicode(ByRef Ansi() As Byte) As String 57 | On Error GoTo ErrHandler 58 | Dim Size As Long 59 | Dim Buf As String 60 | Dim BufLen As Long 61 | Dim RtnLen As Long 62 | 63 | Size = UBound(Ansi) + 1 64 | BufLen = Size * 2 + 10 65 | Buf = String$(BufLen, vbNullChar) 66 | RtnLen = MultiByteToWideChar(0, 0, Ansi(0), Size, StrPtr(Buf), BufLen) 67 | If RtnLen > 0 Then 68 | AnsiToUnicode = Left$(Buf, RtnLen) 69 | End If 70 | ErrHandler: 71 | End Function 72 | -------------------------------------------------------------------------------- /sys_plugin/vim/data/register.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/sys_plugin/vim/data/register.xlsx -------------------------------------------------------------------------------- /sys_plugin/vim/vimize.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "vimize" 2 | 3 | Declare PtrSafe Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) 4 | Declare PtrSafe Function GetKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 5 | 6 | Private buf As Long 7 | 8 | 'Definition for Keyboard event (keybd_event in user32) 9 | Const KEYUP = &H2 ' Key up 10 | Const EXTENDED_KEY = &H1 ' For using extended keys 11 | Const LSHIFT = &HA0 ' Left Shift 12 | Const RSHIFT = &HA1 ' Right Shift 13 | Const LCTRL = &HA2 ' Left Ctrl 14 | Const RCTRL = &HA3 ' Right Ctrl 15 | Const LMENU = &HA4 ' Left Alt 16 | Const RMENU = &HA5 ' Right Alt 17 | Const KANJI = &H19 ' Kanji ' }}} 18 | 19 | Sub main() 20 | Application.Cursor = xlNorthwestArrow 21 | Call keystrokeAsseser.AllKeyToAssesKeyFunc() 22 | Call SetKeyMapping() 23 | Call OpenRegisterBook() 24 | End Sub 25 | 26 | Private Sub SetKeyMapping()'{{{ 27 | Application.OnKey "{F2}" ' used for enter insert-mode. so F2 is not be able to used in vim keybind. 28 | Call nmap("h", "move_left") 29 | Call nmap("j", "move_down") 30 | Call nmap("k", "move_up") 31 | Call nmap("l", "move_right") 32 | Call nmap("gg", "gg") 33 | Call nmap("G", "G") 34 | Call nmap("w", "vim_w") 35 | Call nmap("b", "vim_b") 36 | Call nmap("", "scroll_up") 37 | Call nmap("", "scroll_down") 38 | Call nmap("^", "move_head") 39 | Call nmap("$", "move_tail") 40 | Call nmap("i", "insert_mode") 41 | Call nmap("a", "insert_mode") 42 | Call nmap("V", "n_v_") 43 | Call nmap("v", "n_v") 44 | Call nmap(":", "command_vim") 45 | Call nmap("*", "unite command") 46 | Call nmap("/", "find") 47 | Call nmap("n", "findNext") 48 | Call nmap("N", "findPrevious") 49 | Call nmap("o", "insertRowDown") 50 | Call nmap("O", "insertRowUp") 51 | Call nmap("dd", "n_dd") 52 | Call nmap("dc", "n_dc") 53 | Call nmap("yy", "n_yy") 54 | Call nmap("yv", "yank_value") 55 | Call nmap("p", "n_p") 56 | Call nmap("u", "n_u") 57 | Call nmap("zM", "Collapse_All") 58 | Call nmap("zR", "Expand_All") 59 | 60 | Call nmap("", "n_ESC") 61 | 62 | Call vmap("", "v_ESC") 63 | Call vmap("j", "v_j") 64 | Call vmap("k", "v_k") 65 | Call vmap("h", "v_h") 66 | Call vmap("l", "v_l") 67 | Call vmap("gg", "v_gg") 68 | Call vmap("G", "v_G") 69 | Call vmap("w", "v_w") 70 | Call vmap("b", "v_b") 71 | Call vmap("", "v_scroll_up") 72 | Call vmap("", "v_scroll_down") 73 | Call vmap("^", "v_move_head") 74 | Call vmap("$", "v_move_tail") 75 | Call vmap("a", "v_a") 76 | Call vmap("", "v_move_head") 77 | Call vmap("", "v_move_tail") 78 | Call vmap(":", "command_vim") 79 | Call vmap("y", "v_y") 80 | Call vmap("d", "v_d") 81 | Call vmap("D", "v_D_") 82 | Call vmap("x", "v_x") 83 | Call lvmap("j", "v_j") 'line visual map 84 | Call lvmap("k", "v_k") 85 | Call lvmap("gg", "v_gg") 86 | Call lvmap("G", "v_G") 87 | Call lvmap("", "v_ESC") 88 | Call lvmap("y", "v_y") 89 | Call lvmap("d", "lv_d") 90 | Call lvmap("x", "lv_d") 91 | End Sub'}}} 92 | 93 | '------------Normal Mode---------------------- 94 | Function move_up() '{{{ 95 | ' keybd_event vbKeyUp, 0, EXTENDED_KEY Or 0, 0 96 | ' keybd_event vbKeyUp, 0, EXTENDED_KEY Or KEYUP, 0 97 | Application.EnableEvents = False 98 | If ActiveWindow.VisibleRange.Row = ActiveCell.Row Then 99 | ActiveWindow.SmallScroll Up:=1 100 | End If 101 | On Error Resume Next 102 | ActiveCell.Offset(-1,0).Activate 103 | Err.Number = 0 104 | End Function '}}} 105 | 106 | Function move_down() '{{{ 107 | ' keybd_event vbKeyDown, 0, EXTENDED_KEY Or 0, 0 108 | ' keybd_event vbKeyDown, 0, EXTENDED_KEY Or KEYUP, 0 109 | Application.EnableEvents = False 110 | With ActiveWindow.VisibleRange 111 | If .Row + .Rows.Count - 2 = ActiveCell.Row Then 112 | ActiveWindow.SmallScroll Up:=-1 113 | End If 114 | On Error Resume Next 115 | ActiveCell.Offset(1,0).Activate 116 | Err.Number = 0 117 | End With 118 | End Function '}}} 119 | 120 | Function move_left() '{{{ 121 | ' keybd_event vbKeyLeft, 0, EXTENDED_KEY Or 0, 0 122 | ' keybd_event vbKeyLeft, 0, EXTENDED_KEY Or KEYUP, 0 123 | Application.EnableEvents = False 124 | If ActiveWindow.VisibleRange.Column = ActiveCell.Column Then 125 | ActiveWindow.SmallScroll ToLeft:=1 126 | End If 127 | On Error Resume Next 128 | ActiveCell.Offset(0,-1).Activate 129 | Err.Number = 0 130 | End Function '}}} 131 | 132 | Function move_right() '{{{ 133 | ' keybd_event vbKeyRight, 0, EXTENDED_KEY Or 0, 0 134 | ' keybd_event vbKeyRight, 0, EXTENDED_KEY Or KEYUP, 0 135 | Application.EnableEvents = False 136 | With ActiveWindow.VisibleRange 137 | If .Column + .Columns.Count - 2 = ActiveCell.Column Then 138 | ActiveWindow.SmallScroll ToLeft:=-1 139 | End If 140 | On Error Resume Next 141 | ActiveCell.Offset(0,1).Activate 142 | Err.Number = 0 143 | End With 144 | End Function '}}} 145 | 146 | Sub move_head() '{{{ 147 | Dim startCell As Range 148 | Set startCell = ActiveCell 149 | 150 | Dim dest As Range 151 | Set dest = cells(ActiveCell.Row, 1) 152 | If dest.value = "" Then 153 | Set dest = dest.End(xlToRight) 154 | End If 155 | 156 | If dest.Column = Columns.Count Then 157 | Set dest = Cells(dest.Row, 1) 158 | End If 159 | 160 | dest.Activate 161 | End Sub '}}} 162 | 163 | Sub move_tail() '{{{ 164 | Dim dest As Range 165 | Set dest = cells(ActiveCell.Row, Columns.Count) 166 | If dest.value = "" Then 167 | Set dest = dest.End(xlToLeft) 168 | End If 169 | 170 | dest.Activate 171 | End Sub '}}} 172 | 173 | Public Sub gg() '{{{ 174 | cells(1, ActiveCell.Column).Select 175 | End Sub '}}} 176 | 177 | Public Sub G(Optional numparams As String = "") '{{{ 178 | if numparams = "" Then 179 | With ActiveSheet.UsedRange 180 | cells(.Rows(.Rows.count).Row, ActiveCell.Column).Select 181 | End With 182 | Else 183 | Dim column As Long 184 | Dim row As Long 185 | row = numparams 186 | column = Application.worksheetfunction.min(ActiveCell.column, rows.count) 187 | Cells(row, column).Select 188 | End If 189 | End Sub '}}} 190 | 191 | Sub vim_w() '{{{ 192 | ActiveCell.End(xlToRight).Select 193 | End Sub '}}} 194 | 195 | Sub vim_b() '{{{ 196 | ActiveCell.End(xlToLeft).Select 197 | End Sub '}}} 198 | 199 | Function scroll_up() '{{{ 200 | Dim scroll_width As Integer 201 | 202 | Application.ScreenUpdating = False 203 | selected_range_top = ActiveWindow.VisibleRange.Row 204 | 205 | scroll_width = ActiveWindow.VisibleRange.Rows.count / 2 206 | scroll_target_left = ActiveCell.Column 207 | 208 | scroll_target_top = selected_range_top - scroll_width 209 | 210 | If scroll_target_top < 1 Then 211 | scroll_target_top = 1 212 | End If 213 | 214 | ActiveWindow.SmallScroll Up:=scroll_width 215 | 216 | cells(scroll_target_top, scroll_target_left).Activate 217 | Application.ScreenUpdating = True 218 | 219 | End Function '}}} 220 | 221 | Function scroll_down() '{{{ 222 | Dim scroll_width As Integer 223 | 224 | Application.ScreenUpdating = False 225 | selected_range_top = ActiveWindow.VisibleRange.Row 226 | 227 | scroll_width = ActiveWindow.VisibleRange.Rows.count / 2 228 | scroll_target_left = ActiveCell.Column 229 | 230 | scroll_target_top = selected_range_top + scroll_width 231 | 232 | ActiveWindow.SmallScroll Down:=scroll_width 233 | 234 | cells(scroll_target_top, scroll_target_left).Activate 235 | Application.ScreenUpdating = True 236 | 237 | End Function '}}} 238 | 239 | Sub find() '{{{ 240 | Dim obj As Object 241 | searchString = InputBox("/", "command", "") 242 | If searchString = "" Then 243 | Exit Sub 244 | End If 245 | Set obj = ActiveSheet.cells.find(what:=searchString, lookat:=xlPart) 246 | If Not obj Is Nothing Then 247 | obj.Activate 248 | Else 249 | MsgBox "not found" 250 | End If 251 | 'Selection.FindNext(After:=ActiveCell).Activate 252 | End Sub '}}} 253 | 254 | Function findNext() '{{{ 255 | Dim t As Range 256 | Set t = cells.findNext(After:=ActiveCell) 257 | If t Is Nothing Then 258 | Else 259 | t.Activate 260 | End If 261 | End Function 262 | '}}} 263 | 264 | Function findPrevious() '{{{ 265 | Dim t As Range 266 | Set t = cells.findPrevious(After:=ActiveCell) 267 | If t Is Nothing Then 268 | Else 269 | t.Activate 270 | End If 271 | End Function '}}} 272 | 273 | Function insertRowDown() '{{{ 274 | keyupControlKeys 275 | releaseShiftKeys 276 | keybd_event vbKeyDown, 0, 0, 0 277 | keybd_event vbKeyDown, 0, KEYUP, 0 278 | keybd_event vbKeyMenu, 0, 0, 0 279 | keybd_event vbKeyI, 0, 0, 0 280 | keybd_event vbKeyI, 0, KEYUP, 0 281 | keybd_event vbKeyR, 0, 0, 0 282 | keybd_event vbKeyR, 0, KEYUP, 0 283 | keybd_event vbKeyMenu, 0, KEYUP, 0 284 | unkeyupControlKeys 285 | period_buff = "o" 286 | End Function '}}} 287 | 288 | Function insertRowUp() '{{{ 289 | keyupControlKeys 290 | releaseShiftKeys 291 | keybd_event vbKeyMenu, 0, 0, 0 292 | keybd_event vbKeyI, 0, 0, 0 293 | keybd_event vbKeyI, 0, KEYUP, 0 294 | keybd_event vbKeyR, 0, 0, 0 295 | keybd_event vbKeyR, 0, KEYUP, 0 296 | keybd_event vbKeyMenu, 0, KEYUP, 0 297 | unkeyupControlKeys 298 | period_buff = "+o" 299 | End Function '}}} 300 | 301 | Function insertColumnRight() '{{{ 302 | keyupControlKeys 303 | keybd_event vbKeyRight, 0, 0, 0 304 | keybd_event vbKeyRight, 0, KEYUP, 0 305 | keybd_event vbKeyMenu, 0, 0, 0 306 | keybd_event vbKeyI, 0, 0, 0 307 | keybd_event vbKeyI, 0, KEYUP, 0 308 | keybd_event vbKeyC, 0, 0, 0 309 | keybd_event vbKeyC, 0, KEYUP, 0 310 | keybd_event vbKeyMenu, 0, KEYUP, 0 311 | unkeyupControlKeys 312 | period_buff = "t" 313 | End Function '}}} 314 | 315 | Function insertColumnLeft() '{{{ 316 | keyupControlKeys 317 | releaseShiftKeys 318 | keybd_event vbKeyMenu, 0, 0, 0 319 | keybd_event vbKeyI, 0, 0, 0 320 | keybd_event vbKeyI, 0, KEYUP, 0 321 | keybd_event vbKeyC, 0, 0, 0 322 | keybd_event vbKeyC, 0, KEYUP, 0 323 | keybd_event vbKeyMenu, 0, KEYUP, 0 324 | unkeyupControlKeys 325 | period_buff = "+t" 326 | End Function '}}} 327 | 328 | Public Sub n_ESC()'{{{ 329 | Application.CutCopyMode = False 330 | End Sub'}}} 331 | 332 | Public Sub n_ESC_ime_off()'{{{ 333 | Application.CutCopyMode = False 334 | If IMEStatus <> 2 Then 335 | Call SendKeys("{KANJI}", True) 336 | End if 337 | End Sub'}}} 338 | 339 | Public Sub n_u()'{{{ 340 | 'only works for operation by manual operation. vba command get the history lost.... 341 | keybd_event vbKeyControl, 0, 0, 0 342 | keybd_event vbKeyZ, 0, 0, 0 343 | keybd_event vbKeyZ, 0, KEYUP, 0 344 | keybd_event vbKeyControl, 0, KEYUP, 0 345 | End Sub'}}} 346 | 347 | Public Sub n_yy() '{{{ 348 | Application.ScreenUpdating = False 349 | Call n_v_() 350 | Call v_y() 351 | End Sub '}}} 352 | 353 | Public Sub yank_value() '{{{ 354 | ' ActiveCell.Value 355 | MsgBox "Todo ���" 356 | End Sub '}}} 357 | 358 | Public Sub n_dd() '{{{ 359 | Call n_yy() 360 | Rows(ActiveCell.Row).Delete 361 | End Sub '}}} 362 | 363 | Public Sub n_dc() '{{{ 364 | MsgBox "not implemented yet" 365 | End Sub '}}} 366 | 367 | '----------Mode Chage-------------------------- 368 | Public Sub n_v()'{{{ 369 | buf = ActiveCell.Column 370 | Call SetModeOfVim("visual") 371 | End Sub'}}} 372 | 373 | Public Sub n_v_()'{{{ 374 | buf = ActiveCell.Column 375 | 376 | Rows(ActiveCell.Row).Select 377 | Call SetModeOfVim("line_visual") 378 | 379 | End Sub'}}} 380 | 381 | Public Sub vertival_visual_mode()'{{{ 382 | buf = ActiveCell.Column 383 | 384 | Columns(ActiveCell.Row).Select 385 | Call SetModeOfVim("vertical_visual") 386 | 387 | End Sub'}}} 388 | 389 | Function insert_mode() '{{{ 390 | keyupControlKeys 391 | releaseShiftKeys 392 | keybd_event vbKeyF2, 0, 0, 0 393 | keybd_event vbKeyF2, 0, KEYUP, 0 394 | ' Application.OnTime Now + TimeValue("00:00:00"), "disableIME" 395 | unkeyupControlKeys 396 | End Function '}}} 397 | 398 | Public Sub n_p(Optional registerName As String = """") '{{{ 399 | Application.ScreenUpdating = False 400 | Dim srcRegSheet As Worksheet 401 | Set srcRegSheet = Workbooks("register.xlsx").Worksheets(registerName) 402 | Set srcRange = GetDataRange(srcRegSheet) 403 | srcRange.Copy 404 | 405 | If srcRegSheet.Cells(2, 4).Value = "line_visual" Then 406 | Range(ActiveCell.Row + 1 & ":" & ActiveCell.Row + srcRange.Rows.Count).Insert 407 | Cells(ActiveCell.Row + 1, 1).Select 408 | Else 409 | ActiveCell.Select 410 | End If 411 | 412 | ActiveSheet.Paste 413 | ' Application.ScreenUpdating = True 414 | ' 'ctrl+v�̑��M�undo�̂��߃L�[�{�[�h�Ŏ��� 415 | ' ' ActiveSheet.Paste 416 | ' keybd_event vbKeyControl, 0, 0, 0 417 | ' keybd_event vbKeyV, 0, 0, 0 418 | ' keybd_event vbKeyV, 0, KEYUP, 0 419 | ' keybd_event vbKeyControl, 0, KEYUP, 0 420 | ' ' DoEvents 421 | ' 422 | ' 'ctrl+BackSpace�̑��M��I��͈͂̉��� 423 | ' keybd_event vbKeyShift, 0, 0, 0 424 | ' keybd_event vbKeyBack, 0, EXTENDED_KEY Or 0, 0 425 | ' keybd_event vbKeyBack, 0, EXTENDED_KEY Or KEYUP, 0 426 | ' keybd_event vbKeyShift, 0, KEYUP, 0 427 | End Sub '}}} 428 | 429 | Sub command_vim() '{{{ 430 | Dim commandString As String 431 | 432 | commandString = InputBox("Please Enter Command you wanna do", "command", "") 433 | If commandString = "" Then 434 | Exit Sub 435 | End If 436 | 437 | commandString = Replace(commandString, "!", "_exclamation") ' for [q!] or [w!] command. ! is not allowed in vba function name 438 | Call ExeStringPro(commandString) 439 | End Sub '}}} 440 | 441 | '------------Visual Mode---------------------- 442 | '--------move---------------------'{{{ 443 | Public Sub visual_move(commandString As String) 444 | 'header 445 | 446 | 'main 447 | ExeStringPro(commandString) 448 | 'hooder 449 | End Sub 450 | 451 | 452 | Public Sub v_j()'{{{ 453 | keybd_event vbKeyShift, 0, 0, 0 454 | keybd_event vbKeyDown, 0, EXTENDED_KEY Or 0, 0 455 | keybd_event vbKeyDown, 0, EXTENDED_KEY Or KEYUP, 0 456 | keybd_event vbKeyShift, 0, KEYUP, 0 457 | End Sub'}}} 458 | 459 | Public Sub v_k()'{{{ 460 | keybd_event vbKeyShift, 0, 0, 0 461 | keybd_event vbKeyUp, 0, EXTENDED_KEY Or 0, 0 462 | keybd_event vbKeyUp, 0, EXTENDED_KEY Or KEYUP, 0 463 | keybd_event vbKeyShift, 0, KEYUP, 0 464 | End Sub'}}} 465 | 466 | Public Sub v_h()'{{{ 467 | keybd_event vbKeyShift, 0, 0, 0 468 | keybd_event vbKeyLeft, 0, EXTENDED_KEY Or 0, 0 469 | keybd_event vbKeyLeft, 0, EXTENDED_KEY Or KEYUP, 0 470 | keybd_event vbKeyShift, 0, KEYUP, 0 471 | End Sub'}}} 472 | 473 | Public Sub v_l()'{{{ 474 | keybd_event vbKeyShift, 0, 0, 0 475 | keybd_event vbKeyRight, 0, EXTENDED_KEY Or 0, 0 476 | keybd_event vbKeyRight, 0, EXTENDED_KEY Or KEYUP, 0 477 | keybd_event vbKeyShift, 0, KEYUP, 0 478 | End Sub'}}} 479 | 480 | Public Sub v_gg()'{{{ 481 | Dim buf As Range 482 | Set buf = ActiveCell 483 | 484 | Range(Activecell, Cells(1, Selection(Selection.Count).Column)).Select 485 | 486 | buf.Activate 487 | End Sub'}}} 488 | 489 | Public Sub v_G() '{{{ 490 | Dim buf As Range 491 | Set buf = ActiveCell 492 | 493 | With ActiveSheet.UsedRange 494 | Range(ActiveCell, Cells(.Rows(.Rows.count).Row, Selection(Selection.Count).Column)).Select 495 | End With 496 | 497 | buf.Activate 498 | End Sub '}}} 499 | 500 | Sub v_w() '{{{ 501 | Dim startCell As Range 502 | Set startCell = ActiveCell 503 | 504 | Dim currentRow As Long 505 | If startCell.Row = Selection(1).Row Then 506 | currentRow = Selection(Selection.Count).Row 507 | Else 508 | currentRow = Selection(1).Row 509 | End If 510 | 511 | Dim currentColumn As Long 512 | If startCell.Column = Selection(1).Column Then 513 | currentColumn = Selection(Selection.Count).Column 514 | Else 515 | currentColumn = Selection(1).Column 516 | End If 517 | Dim currentCell As Range 518 | Set currentCell = Cells(currentRow, currentColumn) 519 | 520 | Dim dest As Range 521 | Set dest = cells(currentRow, currentCell.End(xlToRight).Column) 522 | 523 | Range(Activecell, dest).Select 524 | startCell.Activate 525 | End Sub '}}} 526 | 527 | Sub v_b() '{{{ 528 | End Sub '}}} 529 | 530 | Sub v_move_head() '{{{ 531 | Dim startCell As Range 532 | Set startCell = ActiveCell 533 | 534 | Dim currentRow As Long 535 | If startCell.Row = Selection(1).Row Then 536 | currentRow = Selection(Selection.Count).Row 537 | Else 538 | currentRow = Selection(1).Row 539 | End If 540 | 541 | Dim dest As Range 542 | Set dest = cells(currentRow, 1) 543 | If dest.value = "" Then 544 | Set dest = dest.End(xlToRight) 545 | End If 546 | 547 | If dest.Column = Columns.Count Then 548 | Set dest = Cells(dest.Row, 1) 549 | End If 550 | 551 | Range(Activecell, dest).Select 552 | startCell.Activate 553 | End Sub '}}} 554 | 555 | Sub v_move_tail() '{{{ 556 | Dim startCell As Range 557 | Set startCell = ActiveCell 558 | 559 | Dim currentRow As Long 560 | If startCell.Row = Selection(1).Row Then 561 | currentRow = Selection(Selection.Count).Row 562 | Else 563 | currentRow = Selection(1).Row 564 | End If 565 | 566 | Dim dest As Range 567 | Set dest = cells(currentRow, Columns.Count) 568 | If dest.value = "" Then 569 | Set dest = dest.End(xlToLeft) 570 | End If 571 | 572 | Range(Activecell, dest).Select 573 | startCell.Activate 574 | End Sub '}}} 575 | 576 | Sub v_scroll_up() '{{{ 577 | Dim scroll_width As Integer 578 | 579 | Application.ScreenUpdating = False 580 | selected_range_top = ActiveWindow.VisibleRange.Row 581 | 582 | scroll_width = ActiveWindow.VisibleRange.Rows.count / 2 583 | scroll_target_left = ActiveCell.Column 584 | 585 | scroll_target_top = selected_range_top - scroll_width 586 | 587 | If scroll_target_top < 1 Then 588 | scroll_target_top = 1 589 | End If 590 | 591 | ActiveWindow.SmallScroll Up:=scroll_width 592 | 593 | cells(scroll_target_top, scroll_target_left).Activate 594 | Application.ScreenUpdating = True 595 | 596 | End Sub '}}} 597 | 598 | Sub v_scroll_down() '{{{ 599 | Dim scroll_width As Integer 600 | 601 | Application.ScreenUpdating = False 602 | selected_range_top = ActiveWindow.VisibleRange.Row 603 | 604 | scroll_width = ActiveWindow.VisibleRange.Rows.count / 2 605 | scroll_target_left = ActiveCell.Column 606 | 607 | scroll_target_top = selected_range_top + scroll_width 608 | 609 | ActiveWindow.SmallScroll Down:=scroll_width 610 | 611 | cells(scroll_target_top, scroll_target_left).Activate 612 | Application.ScreenUpdating = True 613 | 614 | End Sub '}}} 615 | 616 | Sub v_a() '{{{ 617 | ActiveSheet.UsedRange.Select 618 | End Sub '}}} 619 | '}}} 620 | 621 | '--------operator---------------------'{{{ 622 | Public Sub visual_operation(commandString As String) 623 | 'header 624 | Debug.Print "visual_operation start" 625 | 626 | 'main 627 | ' ExeStringPro(commandString) 628 | Application.Run(commandString) 629 | 'hooder 630 | 631 | Call SetModeOfVim("normal") 632 | End Sub 633 | 634 | Public Sub v_ESC()'{{{ 635 | Call SetModeOfVim("normal") 636 | ActiveCell.Select 637 | End Sub'}}} 638 | 639 | Public Sub v_y(Optional registerName As String = """")'{{{ 640 | Call registerSelection(registerName) 641 | Call v_ESC() 642 | End Sub'}}} 643 | 644 | Public Sub lv_d(Optional registerName As String = """")'{{{ 645 | Application.ScreenUpdating = False 646 | Call registerSelection(registerName) 647 | Selection.Delete Shift:=xlUp 648 | Call v_ESC() 649 | End Sub'}}}'}}} 650 | 651 | Public Sub v_d(Optional registerName As String = """")'{{{ 652 | Application.ScreenUpdating = False 653 | Call registerSelection(registerName) 654 | Selection.ClearContents 655 | Call v_ESC() 656 | End Sub'}}}'}}} 657 | 658 | Public Sub v_x(Optional registerName As String = """")'{{{ 659 | Application.ScreenUpdating = False 660 | Call registerSelection(registerName) 661 | Selection.Clear 662 | Call v_ESC() 663 | End Sub'}}}'}}} 664 | 665 | Public Sub v_D_(Optional registerName As String = """")'{{{ 666 | Application.ScreenUpdating = False 667 | Call registerSelection(registerName) 668 | Selection.Delete Shift:=xlUp 669 | Call v_ESC() 670 | End Sub'}}}'}}} 671 | 672 | '------------Line Visual Mode---------------------- 673 | 674 | '------------Core Functions---------------------------- 675 | Public Sub registerSelection(Optional registerName As String = """")'{{{ 676 | Const destRangeStartRow = 4 677 | Set destRegSheet = Workbooks("register.xlsx").Worksheets(registerName) 678 | 679 | Dim s As Shape 680 | For Each s In destRegSheet.Shapes 681 | s.Delete 682 | Next 683 | destRegSheet.Rows(destRangeStartRow & ":" & Rows.count).Clear 684 | 685 | Set destRange = destRegSheet.Cells(destRangeStartRow,1) 686 | 687 | Selection.Copy(destRange) 688 | destRegSheet.Cells(2,3).Value = Selection.Rows.Count & ":" & Selection.Columns.Count 689 | destRegSheet.Cells(2,4).Value = GetmodeOfVim() 690 | DoEvents 691 | 692 | ' Workbooks("register.xlsx").Save 693 | End Sub'}}} 694 | 695 | '------------Supplimental Functions---------------------------- 696 | Private Function releaseShiftKeys() '{{{ 697 | If GetKeyState(LSHIFT) > 0 Then 698 | keybd_event LSHIFT, 0, KEYUP, 0 699 | DoEvents 700 | ElseIf GetKeyState(RSHIFT) > 0 Then 701 | keybd_event RSHIFT, 0, KEYUP, 0 702 | DoEvents 703 | Else 704 | DoEvents 705 | keybd_event vbKeyShift, 0, KEYUP, 0 706 | End If 707 | End Function '}}} 708 | 709 | Private Function keyupControlKeys() '{{{ 710 | keybd_event LSHIFT, 0, KEYUP, 0 711 | keybd_event RSHIFT, 0, EXTENDED_KEY Or KEYUP, 0 712 | keybd_event LCTRL, 0, KEYUP, 0 713 | keybd_event RCTRL, 0, EXTENDED_KEY Or KEYUP, 0 714 | keybd_event LMENU, 0, KEYUP, 0 715 | keybd_event RMENU, 0, EXTENDED_KEY Or KEYUP, 0 716 | End Function '}}} 717 | 718 | Private Function unkeyupControlKeys() '{{{ 719 | If GetKeyState(LSHIFT) < 0 Then 720 | ElseIf GetKeyState(RSHIFT) < 0 Then 721 | keybd_event RSHIFT, 0, EXTENDED_KEY, 0 722 | Else 723 | keybd_event vbKeyShift, 0, KEYUP, 0 724 | End If 725 | If GetKeyState(LCTRL) < 0 Then 726 | keybd_event LCTRL, 0, 0, 0 727 | ElseIf GetKeyState(RCTRL) < 0 Then 728 | keybd_event RCTRL, 0, EXTENDED_KEY, 0 729 | Else 730 | keybd_event vbKeyControl, 0, KEYUP, 0 731 | End If 732 | If GetKeyState(LMENU) < 0 Then 733 | keybd_event LMENU, 0, 0, 0 734 | ElseIf GetKeyState(RMENU) < 0 Then 735 | keybd_event RMENU, 0, EXTENDED_KEY, 0 736 | Else 737 | keybd_event vbKeyMenu, 0, KEYUP, 0 738 | End If 739 | End Function 740 | '}}} 741 | 742 | Private Sub disableIME()'{{{ 743 | If IMEStatus <> vbIMEModeOff Then 744 | keybd_event KANJI, 0, 0, 0 745 | keybd_event KANJI, 0, KEYUP, 0 746 | End If 747 | End Sub'}}} 748 | 749 | Private Sub OpenRegisterBook()'{{{ 750 | Dim book As Workbook 751 | Dim opened As Boolean 752 | Dim cursetting_su As Boolean 753 | Dim register_file_path As String: register_file_path = ThisWorkbook.Path & "\sys_plugin\vim\data\register.xlsx" 754 | 755 | opened = False 756 | For Each book in Workbooks 757 | If register_file_path = book.FullName Then 758 | opened = True 759 | Exit For 760 | End If 761 | Next 762 | 763 | If not opened Then 764 | cursetting_su = Application.ScreenUpdating 765 | Application.ScreenUpdating = False 766 | Workbooks.Open FileName:= register_file_path 767 | Windows("register.xlsx").Visible = False 768 | Application.ScreenUpdating = cursetting_su 769 | End If 770 | End Sub'}}} 771 | 772 | Private Function GetDataRange(sh As Worksheet) As Range'{{{ 773 | Const dataStartRow = 4 774 | ' Set GetDataRange = InterSect(sh.UsedRange, sh.Rows(dataStartRow & ":" & sh.Rows.Count)) 775 | dataSizeOfRows = Split(sh.Cells(2,3).Value, ":")(0) 776 | dataSizeOfColumns = Split(sh.Cells(2,3).Value, ":")(1) 777 | Set GetDataRange = sh.Cells(dataStartRow, 1).Resize(dataSizeOfRows, dataSizeOfColumns) 778 | End Function'}}} 779 | 780 | Private Sub RegisterToDataRange(srcRange As Range, Optional registerName As String = """")'{{{ 781 | Const destRangeStartRow = 4 782 | Set destRegSheet = Workbooks("register.xlsx").Worksheets(registerName) 783 | destRegSheet.Rows(destRangeStartRow & ":" & Rows.count).Clear 784 | Set destRange = destRegSheet.Cells(destRangeStartRow,1) 785 | 786 | srcRange.Copy(destRange) 787 | End Sub'}}} 788 | -------------------------------------------------------------------------------- /ver2.4.5: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/ver2.4.5 -------------------------------------------------------------------------------- /vimx.xlam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kjnh10/ExcelLikeVim/c096a911d2100cbba898312d36cc29418938dc2a/vimx.xlam --------------------------------------------------------------------------------