Initial commit
This commit is contained in:
IRBorisov
commit
879fd2ef51
37
VBAMake.txt
Normal file
37
VBAMake.txt
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact_home, source_home
|
||||
|
||||
id = ExcelHelper
|
||||
name = ExcelHelper
|
||||
description = Надстройка КОНЦЕПТ для Excel
|
||||
artifact_home = Addins
|
||||
source_home = ExcelAI
|
||||
install_home = \\fs1.concept.ru\projects\04 Направления деятельности\60 КИВТ\21 Надстройки\EXCEL
|
||||
|
||||
%%
|
||||
# === Build section ===
|
||||
# Available commands:
|
||||
# build LOCAL_MANIFEST
|
||||
# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
|
||||
# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
|
||||
# run LOCAL_SOURCE.bat
|
||||
|
||||
build script\manifest.txt
|
||||
save_as CONCEPT.xlsm -> CONCEPT.xlam
|
||||
copy distr\Excel.docx
|
||||
|
||||
%%
|
||||
# === Install section ==
|
||||
# Available commands:
|
||||
# install LOCAL_ARTIFACT -> [INSTALL_PATH]
|
||||
# add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
|
||||
# run LOCAL_ARTIFACT.bat <- [PARAMETERS]
|
||||
# run APPLICATION <- [PARAMETERS]
|
||||
|
||||
install CONCEPT.xlam
|
||||
install CONCEPT.xlam -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Excel\CONCEPT.xlam
|
||||
|
||||
install Excel.docx
|
||||
install Excel.docx -> \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\!Надстройки\Excel.docx
|
||||
BIN
distr/Excel.docx
Normal file
BIN
distr/Excel.docx
Normal file
Binary file not shown.
93
script/manifest.txt
Normal file
93
script/manifest.txt
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact
|
||||
|
||||
name = CONCEPT.xlsm
|
||||
artifact = CONCEPT.xlsm
|
||||
|
||||
%%
|
||||
# === Imports Section ===
|
||||
# Hierarchy of folders and files
|
||||
# Use Tabulator to mark next level in hierarchy
|
||||
# All folders are nested into SharedHome path
|
||||
|
||||
dev
|
||||
DevTester.bas
|
||||
ex_ConceptOrganization.bas
|
||||
|
||||
api
|
||||
ex_Python.bas
|
||||
ex_WinAPI.bas
|
||||
ex_ConceptCore.bas
|
||||
|
||||
API_Python.cls
|
||||
API_Path.cls
|
||||
API_WordWrapper.cls
|
||||
API_XLWrapper.cls
|
||||
API_UserInteraction.cls
|
||||
|
||||
excel
|
||||
ex_Excel.bas
|
||||
|
||||
utility
|
||||
ex_VBA.bas
|
||||
ex_DataPreparation.bas
|
||||
ex_Version.bas
|
||||
|
||||
API_DistrManifest.cls
|
||||
API_Config.cls
|
||||
API_JSON.cls
|
||||
API_Timer.cls
|
||||
|
||||
ui
|
||||
CSE_ProgressBar.frm
|
||||
|
||||
%%
|
||||
# === Source Code Section ==
|
||||
# Hierarchy of folders and files
|
||||
# Use Tabulator to mark next level in hierarchy
|
||||
# All folders are nested into SourceHome path
|
||||
|
||||
src
|
||||
DevHelper.bas
|
||||
Declarations.bas
|
||||
Main.bas
|
||||
MainImpl.bas
|
||||
PublicFunctions.bas
|
||||
z_UIMessages.bas
|
||||
z_UIRibbon.bas
|
||||
|
||||
AddinOptions.cls
|
||||
CellProcessor.cls
|
||||
LinksOutput.cls
|
||||
LinksRelocator.cls
|
||||
SearchEngine.cls
|
||||
ParametersSearch.cls
|
||||
|
||||
WordDlg.frm
|
||||
RelocateDlg.frm
|
||||
SearchDlg.frm
|
||||
|
||||
%%
|
||||
# ===== UI Section =======
|
||||
# Pairs of path to UI elements, use " -> " delimiter
|
||||
# First component is a path relative to SourceHome\ui folders
|
||||
# Second component is internal path inside project file
|
||||
|
||||
.rels -> _rels\.rels
|
||||
customUI.xml -> customUI\customUI.xml
|
||||
|
||||
%%
|
||||
# === References Section ===
|
||||
# List dependencies in one of the formats
|
||||
# global : GLOBAL_NAME
|
||||
# guid : {REGISTERED_GUID}
|
||||
# file : PATH_TO_LIBRARY
|
||||
|
||||
global : Scripting
|
||||
global : MSForms
|
||||
global : Word
|
||||
global : Shell32
|
||||
global : ADODB
|
||||
global : IWshRuntimeLibrary
|
||||
BIN
skeleton/CONCEPT.xlsm
Normal file
BIN
skeleton/CONCEPT.xlsm
Normal file
Binary file not shown.
31
src/AddinOptions.cls
Normal file
31
src/AddinOptions.cls
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "AddinOptions"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public data_ As Scripting.Dictionary
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set data_ = New Scripting.Dictionary
|
||||
Dim nItem&
|
||||
For nItem = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
|
||||
data_.Item(nItem) = False
|
||||
Next nItem
|
||||
End Sub
|
||||
|
||||
Public Function CheckProductEnabled(sProduct$) As Boolean
|
||||
Dim nItem&
|
||||
For nItem = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
|
||||
If sProduct = ProductNameFromID(nItem) Then
|
||||
CheckProductEnabled = data_.Item(nItem)
|
||||
Exit Function
|
||||
End If
|
||||
Next nItem
|
||||
CheckProductEnabled = True
|
||||
End Function
|
||||
84
src/CellProcessor.cls
Normal file
84
src/CellProcessor.cls
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "CellProcessor"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public countAll_ As Long
|
||||
Public countInvalid_ As Long
|
||||
|
||||
Private fso_ As Scripting.FileSystemObject
|
||||
|
||||
Public Function Init()
|
||||
countAll_ = 0
|
||||
countInvalid_ = 0
|
||||
Set fso_ = New Scripting.FileSystemObject
|
||||
End Function
|
||||
|
||||
Public Function TrimCell(target As Excel.Range)
|
||||
target = TrimWhitespace(target.Text)
|
||||
End Function
|
||||
|
||||
Public Function TrimCellPunctuation(target As Excel.Range)
|
||||
target = TrimEndPunctuation(target.Text)
|
||||
End Function
|
||||
|
||||
Public Function SubstituteWS(target As Excel.Range)
|
||||
target = SubstituteWhitespace(target.Text)
|
||||
End Function
|
||||
|
||||
Public Function CreateHyperlink(target As Excel.Range)
|
||||
Call XLUpdateHyperlink(target, target.Text)
|
||||
End Function
|
||||
|
||||
Public Function SplitTextIntoColumn(target As Excel.Range)
|
||||
Dim vWords As Variant: vWords = VBA.Split(target.Text, " ")
|
||||
If VBA.VarType(vWords) < vbArray Or VBA.VarType(vWords) > vbArray + vbByte Then _
|
||||
Call Err.Raise(1000, Description:=vWords)
|
||||
|
||||
Dim output As Excel.Range: Set output = target
|
||||
Dim sWord As Variant
|
||||
For Each sWord In vWords
|
||||
Set output = output.Offset(1, 0)
|
||||
output = CStr(sWord)
|
||||
Next sWord
|
||||
End Function
|
||||
|
||||
Public Function ValidateHyperlink(target As Excel.Range)
|
||||
If target.Hyperlinks.Count = 0 Then _
|
||||
Exit Function
|
||||
|
||||
countAll_ = countAll_ + 1
|
||||
If IsValidHyperlink(target) Then
|
||||
target.Interior.ColorIndex = xlNone
|
||||
Else
|
||||
target.Interior.Color = VBA.RGB(253, 233, 217)
|
||||
countInvalid_ = countInvalid_ + 1
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function FixServerLink(target As Excel.Range)
|
||||
countAll_ = countAll_ + 1
|
||||
|
||||
Dim iPath As New API_Path: Call iPath.FromString(target.Text).GlobalToServer
|
||||
If iPath.Text = target.Text Then _
|
||||
Exit Function
|
||||
|
||||
target = iPath.Text
|
||||
Call XLUpdateHyperlink(target, iPath.Text)
|
||||
countInvalid_ = countInvalid_ + 1
|
||||
End Function
|
||||
|
||||
' ======
|
||||
Private Function IsValidHyperlink(target As Excel.Range) As Boolean
|
||||
Dim sFile$: sFile = target.Hyperlinks(1).Address
|
||||
Dim iPath As New API_Path: Call iPath.FromString(sFile).ToGlobal(target.Parent.Parent.Path)
|
||||
IsValidHyperlink = iPath.GlobalExists
|
||||
End Function
|
||||
|
||||
|
||||
47
src/Declarations.bas
Normal file
47
src/Declarations.bas
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
Attribute VB_Name = "Declarations"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Const APP_HELP = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\02 Îôèñíàÿ àâòîìàòèçàöèÿ\!Íàäñòðîéêè\Excel.docx"
|
||||
|
||||
Public Const CONCEPT_LOCAL_HOME = ".concept"
|
||||
Public Const CONCEPT_SERVER_HOME = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\!Concept"
|
||||
|
||||
Public Const CONCEPT_BANNED_WORDS = "banned-words.txt"
|
||||
|
||||
Public Const SERVER_TEMPLATES_FOLDER = "\\fs1.concept.ru\Data\Templates"
|
||||
Public Const LOCAL_TEMPLATES_FOLDER = "Microsoft\Øàáëîíû"
|
||||
|
||||
Public Const PROJECTS_FIRST_ROW = 2
|
||||
Public Const VISIO_DEFAULT_GAP = 0.254
|
||||
|
||||
' Matching mode
|
||||
Public Enum TMatchMode
|
||||
T_MM_DEFAULT = 1
|
||||
T_MM_SPACE_LEFT = 2
|
||||
T_MM_SPACE_RIGHT = 3
|
||||
T_MM_SPACE_BOTH = 4
|
||||
End Enum
|
||||
|
||||
' Word Addins
|
||||
Public Enum TWordAddin
|
||||
[_First] = 1
|
||||
|
||||
T_WA_CONCEPT = 1
|
||||
T_WA_NPA = 2
|
||||
T_WA_MARKUP = 3
|
||||
T_WA_PARSERS = 4
|
||||
T_WA_MAKET = 5
|
||||
|
||||
[_Last] = 5
|
||||
End Enum
|
||||
|
||||
Public Function ProductNameFromID(nID As TWordAddin) As String
|
||||
Select Case nID
|
||||
Case T_WA_CONCEPT: ProductNameFromID = "WordHelper"
|
||||
Case T_WA_NPA: ProductNameFromID = "Concept-NPA"
|
||||
Case T_WA_MARKUP: ProductNameFromID = "Concept-Markup"
|
||||
Case T_WA_PARSERS: ProductNameFromID = "Concept-Mining"
|
||||
Case T_WA_MAKET: ProductNameFromID = "Concept-Maket"
|
||||
End Select
|
||||
End Function
|
||||
20
src/DevHelper.bas
Normal file
20
src/DevHelper.bas
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
Attribute VB_Name = "DevHelper"
|
||||
Option Explicit
|
||||
|
||||
Public Function Dev_PrepareSkeleton()
|
||||
' Do nothing
|
||||
End Function
|
||||
|
||||
Public Sub Dev_ManualRunTest()
|
||||
Dim sSuite$: sSuite = "s_UndoWrapper"
|
||||
Dim sTest$: sTest = "t_BasicUndo"
|
||||
Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest)
|
||||
Debug.Print sMsg
|
||||
Call MsgBox(sMsg)
|
||||
End Sub
|
||||
|
||||
Public Function Dev_GetTestSuite(sName$) As Object
|
||||
Select Case sName
|
||||
' Case "s_ParseDate": Set Dev_GetTestSuite = New s_ParseDate
|
||||
End Select
|
||||
End Function
|
||||
36
src/LinksOutput.cls
Normal file
36
src/LinksOutput.cls
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "LinksOutput"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private out_ As Excel.Range
|
||||
Private mask_ As String
|
||||
|
||||
Public countAdded_ As Long
|
||||
Public countAll_ As Long
|
||||
|
||||
Public Function Init(iOut As Excel.Range, sMask$)
|
||||
Set out_ = iOut
|
||||
countAdded_ = 0
|
||||
countAll_ = 0
|
||||
mask_ = sMask
|
||||
End Function
|
||||
|
||||
Public Function ProcessFile(iFile As Scripting.File)
|
||||
countAll_ = countAll_ + 1
|
||||
If Not iFile.Path Like mask_ Then _
|
||||
Exit Function
|
||||
|
||||
Dim iCell As Excel.Range: Set iCell = out_.Offset(countAdded_, 0)
|
||||
iCell = iFile.Path
|
||||
|
||||
On Error Resume Next
|
||||
Call iCell.Hyperlinks.Add(iCell, iFile.Path)
|
||||
countAdded_ = countAdded_ + 1
|
||||
End Function
|
||||
76
src/LinksRelocator.cls
Normal file
76
src/LinksRelocator.cls
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "LinksRelocator"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private fso_ As Scripting.FileSystemObject
|
||||
Private prefix_ As String
|
||||
Private destination_ As String
|
||||
Private home_ As String
|
||||
Private removeSource_ As Boolean
|
||||
|
||||
Public countAll_ As Long
|
||||
Public countRelocated_ As Long
|
||||
|
||||
Public Function Init(sDestination$, sPrefix$, sHome$, bRemoveSource As Boolean)
|
||||
Set fso_ = New Scripting.FileSystemObject
|
||||
prefix_ = sPrefix
|
||||
destination_ = sDestination
|
||||
home_ = sHome
|
||||
removeSource_ = bRemoveSource
|
||||
|
||||
countAll_ = 0
|
||||
countRelocated_ = 0
|
||||
End Function
|
||||
|
||||
Public Function ProcessCell(target As Excel.Range)
|
||||
If target.Hyperlinks.Count = 0 Then _
|
||||
Exit Function
|
||||
|
||||
countAll_ = countAll_ + 1
|
||||
Dim iPath As New API_Path: Call iPath.FromString(target.Value).ToGlobal(home_)
|
||||
Dim iRelativePath As API_Path: Set iRelativePath = iPath.Clone.ToLocal(prefix_)
|
||||
If iRelativePath.Text = iPath.Text Then _
|
||||
Set iRelativePath = GenerateLocalPath(iPath.FileName)
|
||||
|
||||
If Not iPath.GlobalExists Then _
|
||||
GoTo MARK_FAILURE
|
||||
|
||||
Dim iDestination As API_Path: Set iDestination = iRelativePath.Clone
|
||||
Call iDestination.ToGlobal(destination_)
|
||||
|
||||
If removeSource_ Then
|
||||
If Not MoveFileOrFolder(iPath.Text, iDestination.Text, fso_) Then _
|
||||
GoTo MARK_FAILURE
|
||||
Else
|
||||
If Not CopyFileOrFolder(iPath.Text, iDestination.Text, fso_) Then _
|
||||
GoTo MARK_FAILURE
|
||||
End If
|
||||
|
||||
target = iDestination.Text
|
||||
Call XLUpdateHyperlink(target, iDestination.Text)
|
||||
target.Interior.ColorIndex = xlNone
|
||||
countRelocated_ = countRelocated_ + 1
|
||||
Exit Function
|
||||
|
||||
MARK_FAILURE:
|
||||
target.Interior.Color = VBA.RGB(253, 233, 217)
|
||||
End Function
|
||||
|
||||
' ======
|
||||
Private Function GenerateLocalPath(sName$) As API_Path
|
||||
Dim iPath As New API_Path: Call iPath.FromString(sName)
|
||||
Call iPath.ToGlobal(destination_)
|
||||
Dim nCopy&: nCopy = 1
|
||||
Do While iPath.GlobalExists
|
||||
Call iPath.FromString(Fmt("{1}_{2}.{3}", iPath.BaseName, nCopy, iPath.Extension))
|
||||
Call iPath.ToGlobal(destination_)
|
||||
Loop
|
||||
Set GenerateLocalPath = iPath
|
||||
End Function
|
||||
295
src/Main.bas
Normal file
295
src/Main.bas
Normal file
|
|
@ -0,0 +1,295 @@
|
|||
Attribute VB_Name = "Main"
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
Public Sub CC_RunGroupByRank()
|
||||
Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
|
||||
Dim nRow&: nRow = 1
|
||||
Dim sTxt$
|
||||
Do
|
||||
sTxt = iSelection.Cells(nRow, 1)
|
||||
If sTxt = vbNullString Then _
|
||||
Exit Do
|
||||
If IsNumeric(sTxt) Then _
|
||||
iSelection.Rows(nRow).OutlineLevel = CLng(sTxt)
|
||||
nRow = nRow + 1
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunGroupByID()
|
||||
Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
|
||||
Dim nRow&: nRow = 1
|
||||
Dim lastID$: lastID = vbNullString
|
||||
Dim curID$
|
||||
Do
|
||||
curID = iSelection.Cells(nRow, 1)
|
||||
If curID = vbNullString Then _
|
||||
Exit Do
|
||||
iSelection.Rows(nRow).OutlineLevel = IIf(lastID = curID, 2, 1)
|
||||
lastID = curID
|
||||
nRow = nRow + 1
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunClearFormatting()
|
||||
Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
|
||||
Do While iSelection.FormatConditions.Count > 0
|
||||
Call iSelection.FormatConditions.Item(1).Delete
|
||||
Loop
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunTrimCells()
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=New CellProcessor, _
|
||||
sFuncName:="TrimCell")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunTrimPunctuation()
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=New CellProcessor, _
|
||||
sFuncName:="TrimCellPunctuation")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunSubstituteWhitespace()
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=New CellProcessor, _
|
||||
sFuncName:="SubstituteWS")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksCreate()
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=New CellProcessor, _
|
||||
sFuncName:="CreateHyperlink")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunSplitText()
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=New CellProcessor, _
|
||||
sFuncName:="SplitTextIntoColumn")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksScan()
|
||||
Dim sMask$: sMask = UserInteraction.PromptInput("Ââåäèòå ìàñêó îòáèðàåìûõ ôàéëîâ", sInitial:="*.*")
|
||||
If sMask = vbNullString Then _
|
||||
Exit Sub
|
||||
Dim sFolder$: sFolder = UserInteraction.PromptFolder(ActiveWorkbook.Path & "\")
|
||||
If sFolder = vbNullString Then _
|
||||
Exit Sub
|
||||
|
||||
Dim iScanner As New LinksOutput: Call iScanner.Init(ActiveWorkbook.Application.Selection.Cells(1, 1), sMask)
|
||||
Call ForEachFileRecursive(sFolder, iScanner, "ProcessFile")
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_LINKS_SCAN_OK, iScanner.countAdded_, iScanner.countAll_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksValidate()
|
||||
Dim iProcessor As New CellProcessor: Call iProcessor.Init
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=iProcessor, _
|
||||
sFuncName:="ValidateHyperlink")
|
||||
Call UserInteraction.ShowMessage(IM_LINKS_VALIDATION, iProcessor.countInvalid_, iProcessor.countAll_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksServer()
|
||||
Dim iProcessor As New CellProcessor: Call iProcessor.Init
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=iProcessor, _
|
||||
sFuncName:="FixServerLink")
|
||||
Call UserInteraction.ShowMessage(IM_LINKS_SERVER, iProcessor.countInvalid_, iProcessor.countAll_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksRelocate()
|
||||
Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
|
||||
Dim iSelection As Excel.Range: Set iSelection = iTarget.Application.Selection
|
||||
If iSelection.Hyperlinks.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sInitFolder$: sInitFolder = fso.GetParentFolderName(iSelection.Hyperlinks(1).Address)
|
||||
Call RelocateDlg.Init(sInitFolder)
|
||||
Call RelocateDlg.Show
|
||||
If RelocateDlg.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim iProcessor As New LinksRelocator: Call iProcessor.Init(RelocateDlg.Path, RelocateDlg.Prefix, iTarget.Path, bRemoveSource:=True)
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=iProcessor, _
|
||||
sFuncName:="ProcessCell")
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_LINKS_RELOCATE_OK, iProcessor.countRelocated_, iProcessor.countAll_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksCopyFiles()
|
||||
Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
|
||||
Dim iSelection As Excel.Range: Set iSelection = iTarget.Application.Selection
|
||||
If iSelection.Hyperlinks.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sInitFolder$: sInitFolder = fso.GetParentFolderName(iSelection.Hyperlinks(1).Address)
|
||||
Call RelocateDlg.Init(sInitFolder)
|
||||
Call RelocateDlg.Show
|
||||
If RelocateDlg.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim iProcessor As New LinksRelocator: Call iProcessor.Init(RelocateDlg.Path, RelocateDlg.Prefix, iTarget.Path, bRemoveSource:=False)
|
||||
Call XLForEachNonEmptyCell( _
|
||||
target:=ActiveWorkbook.Application.Selection, _
|
||||
oCallback:=iProcessor, _
|
||||
sFuncName:="ProcessCell")
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_LINKS_COPY_OK, iProcessor.countRelocated_, iProcessor.countAll_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunListIncome()
|
||||
Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_INCOME)
|
||||
If iProjects Is Nothing Then _
|
||||
Exit Sub
|
||||
Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunListOutcome()
|
||||
Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_OUTCOME)
|
||||
If iProjects Is Nothing Then _
|
||||
Exit Sub
|
||||
Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunListLeads()
|
||||
Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_LEAD_ACTIVE)
|
||||
If iProjects Is Nothing Then _
|
||||
Exit Sub
|
||||
Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunListTentative()
|
||||
Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_LEAD_TENTATIVE)
|
||||
If iProjects Is Nothing Then _
|
||||
Exit Sub
|
||||
Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunLinksPrint()
|
||||
Dim selRange As Excel.Range: Set selRange = ActiveWorkbook.Application.Selection
|
||||
Dim theLinks As Excel.Hyperlinks: Set theLinks = selRange.Hyperlinks
|
||||
If theLinks.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call PrintLinks(theLinks)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunConfig()
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sConfigPath$: sConfigPath = ConceptConfigPath
|
||||
If Not fso.FileExists(sConfigPath) Then _
|
||||
Call SetupConfig(sConfigPath)
|
||||
|
||||
Dim oShell As New Shell32.Shell
|
||||
Call oShell.Open(sConfigPath)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunWordAddin()
|
||||
If Not ValidateNoWordOpen Then
|
||||
Call UserInteraction.ShowMessage(EM_WORD_IS_OPEN)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim iCurrent As AddinOptions: Set iCurrent = ScanAddinOptions()
|
||||
Call WordDlg.Init(iCurrent)
|
||||
Call WordDlg.Show
|
||||
If WordDlg.isCanceled_ Then _
|
||||
Exit Sub
|
||||
|
||||
If ApplyAddins(iCurrent, WordDlg.GetResult) Then
|
||||
Call UserInteraction.ShowMessage(IM_WORD_ADDINS_OK)
|
||||
Else
|
||||
Call UserInteraction.ShowMessage(EM_WORD_ADDINS_FAILED)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunUpdateTemplates()
|
||||
If Not ValidateNoWordOpen Then
|
||||
Call UserInteraction.ShowMessage(EM_WORD_IS_OPEN)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If CopyFileOrFolder( _
|
||||
sSource:=SERVER_TEMPLATES_FOLDER, _
|
||||
sDestination:=VBA.Environ$("APPDATA") & "\" & LOCAL_TEMPLATES_FOLDER) Then
|
||||
Call UserInteraction.ShowMessage(IM_TEMPLATES_OK)
|
||||
Else
|
||||
Call UserInteraction.ShowMessage(EM_TEMPLATES_FAILED)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunUpdateConceptCore()
|
||||
Call AccessPython.UnloadDLL
|
||||
Call UnloadConceptCore
|
||||
|
||||
If Not UpdateConceptPowershell Then
|
||||
Call UserInteraction.ShowMessage(EM_CORE_UPDATE_FAILED)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call UnregisterUDF
|
||||
Call RegisterUDF
|
||||
Call UserInteraction.ShowMessage(IM_CONCEPT_UPDATE_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunConceptStatus()
|
||||
Dim iExcel As New API_XLWrapper
|
||||
Call iExcel.NewDocument
|
||||
|
||||
Call OutputConceptStatus(iExcel.Document.Sheets(1))
|
||||
|
||||
Call iExcel.Document.Activate
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunAppdata()
|
||||
Dim oShell As New Shell32.Shell
|
||||
Call oShell.Open(VBA.Environ$("APPDATA") & "\Microsoft")
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunAnalyseSearch()
|
||||
Dim iDoc As Excel.Workbook: Set iDoc = Excel.ActiveWorkbook
|
||||
|
||||
Call SearchDlg.Init(iDoc)
|
||||
Call SearchDlg.Show
|
||||
If SearchDlg.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim params As ParametersSearch: Set params = SearchDlg.ResultParams
|
||||
Call ExecuteSearch(iDoc, params)
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_SEARCH_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunHelp()
|
||||
Dim iWord As New API_WordWrapper
|
||||
Dim iHelp As Word.Document: Set iHelp = iWord.OpenDocument(APP_HELP, bReadOnly:=True)
|
||||
If iHelp Is Nothing Then _
|
||||
Exit Sub
|
||||
|
||||
With iHelp
|
||||
.ActiveWindow.View.ReadingLayout = False
|
||||
Call .Application.Activate
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RunDescriptionUDF()
|
||||
Call RegisterUDF
|
||||
End Sub
|
||||
168
src/MainImpl.bas
Normal file
168
src/MainImpl.bas
Normal file
|
|
@ -0,0 +1,168 @@
|
|||
Attribute VB_Name = "MainImpl"
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
Public Function PasteProjects(ByVal rWhere As Excel.Range, iProjects As Scripting.Dictionary)
|
||||
If iProjects.Count = 0 Then _
|
||||
Exit Function
|
||||
|
||||
Set rWhere = rWhere.Cells(1, 1)
|
||||
If Not IsEmpty(rWhere) Then
|
||||
Call rWhere.Offset(1).EntireRow.Insert
|
||||
Set rWhere = rWhere.Offset(1)
|
||||
End If
|
||||
|
||||
Dim aKey As Variant
|
||||
For Each aKey In iProjects
|
||||
If IsEmpty(rWhere) Then _
|
||||
GoTo PASTE_PRJ
|
||||
|
||||
Call rWhere.EntireRow.Insert
|
||||
Set rWhere = rWhere.Offset(-1)
|
||||
Call rWhere.Offset(-1).Copy(rWhere)
|
||||
|
||||
PASTE_PRJ:
|
||||
rWhere = CStr(aKey)
|
||||
Set rWhere = rWhere.Offset(1)
|
||||
Next aKey
|
||||
End Function
|
||||
|
||||
Public Function PrintLinks(iLinks As Excel.Hyperlinks)
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim iShell As New Shell32.Shell
|
||||
Dim aLink As Excel.Hyperlink
|
||||
For Each aLink In iLinks
|
||||
Dim sAddress$: sAddress = fso.GetAbsolutePathName(aLink.Address)
|
||||
If sAddress = vbNullString Then _
|
||||
GoTo NEXT_LINK
|
||||
If Not fso.FileExists(sAddress) Then _
|
||||
GoTo NEXT_LINK
|
||||
Call iShell.ShellExecute(sAddress, vOperation:="Print")
|
||||
|
||||
NEXT_LINK:
|
||||
Next aLink
|
||||
End Function
|
||||
|
||||
Public Function SetupConfig(sPath$)
|
||||
Dim iConfig As API_Config: Set iConfig = ConceptConfig
|
||||
Call iConfig.SaveToFile(sPath)
|
||||
End Function
|
||||
|
||||
Public Function ValidateNoWordOpen() As Boolean
|
||||
On Error Resume Next
|
||||
Dim iWord As Word.Application: Set iWord = GetObject(, "Word.Application")
|
||||
ValidateNoWordOpen = Err.Number <> 0 Or iWord Is Nothing
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
Public Function ScanAddinOptions() As AddinOptions
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sLocals$: sLocals = VBA.Environ$("APPDATA") & "\Microsoft\Word\STARTUP"
|
||||
Set ScanAddinOptions = New AddinOptions
|
||||
With ScanAddinOptions
|
||||
.data_.Item(T_WA_CONCEPT) = fso.FileExists(sLocals & "\" & ADDIN_NAME_CONCEPT)
|
||||
.data_.Item(T_WA_NPA) = fso.FileExists(sLocals & "\" & ADDIN_NAME_NPA)
|
||||
.data_.Item(T_WA_MARKUP) = fso.FileExists(sLocals & "\" & ADDIN_NAME_MARKUP)
|
||||
.data_.Item(T_WA_PARSERS) = fso.FileExists(sLocals & "\" & ADDIN_NAME_PARSER)
|
||||
.data_.Item(T_WA_MAKET) = fso.FileExists(sLocals & "\" & ADDIN_NAME_MAKET)
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function ApplyAddins(iCurrent As AddinOptions, iNew As AddinOptions) As Boolean
|
||||
ApplyAddins = False
|
||||
|
||||
Dim sParams$
|
||||
Dim nID As TWordAddin
|
||||
For nID = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
|
||||
If iNew.data_.Item(nID) Then
|
||||
If sParams <> vbNullString Then _
|
||||
sParams = sParams & ", "
|
||||
sParams = sParams & ProductNameFromID(nID) & "+"
|
||||
ElseIf iCurrent.data_.Item(nID) Then
|
||||
If sParams <> vbNullString Then _
|
||||
sParams = sParams & ", "
|
||||
sParams = sParams & ProductNameFromID(nID) & "-"
|
||||
End If
|
||||
Next nID
|
||||
|
||||
ApplyAddins = VersionUpdateProducts(sParams)
|
||||
End Function
|
||||
|
||||
Public Function ExecuteSearch(target As Excel.Workbook, params As ParametersSearch)
|
||||
Dim iOut As Excel.Worksheet: Set iOut = target.Sheets.Add
|
||||
Dim iEngine As New SearchEngine
|
||||
Call iEngine.Init(iOut, params)
|
||||
Call iEngine.Execute
|
||||
End Function
|
||||
|
||||
Public Function UpdateConceptPowershell() As Boolean
|
||||
UpdateConceptPowershell = False
|
||||
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sInstall$: sInstall = CP_TOOLS_SERVER & "\" & CONCEPT_INSTALLER
|
||||
If Not fso.FileExists(sInstall) Then _
|
||||
Exit Function
|
||||
|
||||
On Error GoTo RETURN_FALSE
|
||||
Dim sExec$: sExec = "cmd.exe /c " & """" & sInstall & """" & " < nul"
|
||||
Dim iShell As New WshShell
|
||||
iShell.CurrentDirectory = CP_TOOLS_SERVER
|
||||
UpdateConceptPowershell = iShell.Run(sExec, waitOnReturn:=True) = 0
|
||||
Exit Function
|
||||
|
||||
RETURN_FALSE:
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
Public Function OutputConceptStatus(iOut As Excel.Worksheet)
|
||||
With iOut
|
||||
.Cells(1, 1) = "ProductID"
|
||||
.Cells(1, 2) = "Ëîêàëüíàÿ âåðñèÿ"
|
||||
.Cells(1, 3) = "Ñåðâåðíàÿ âåðñèÿ"
|
||||
.Cells(1, 4) = "Àêòèâíûé ïðîäóêò"
|
||||
.Columns(1).ColumnWidth = 25
|
||||
.Columns(2).ColumnWidth = 15
|
||||
.Columns(3).ColumnWidth = 15
|
||||
.Columns(4).ColumnWidth = 15
|
||||
End With
|
||||
|
||||
Dim nRow&: nRow = 2
|
||||
|
||||
Dim iLocal As API_DistrManifest: Set iLocal = VersionLocalManifest
|
||||
Dim iServer As API_DistrManifest: Set iServer = VersionServerManifest
|
||||
Dim iEnabled As AddinOptions: Set iEnabled = ScanAddinOptions
|
||||
|
||||
Dim iProduct As Variant
|
||||
For Each iProduct In iLocal.data_.Keys
|
||||
Dim sProduct$: sProduct = VBA.CStr(iProduct)
|
||||
|
||||
Dim sLocalVer$: sLocalVer = iLocal.GetVersion(sProduct)
|
||||
If sLocalVer = vbNullString Then _
|
||||
sLocalVer = "íåò äàííûõ"
|
||||
|
||||
Dim sServerVer$: sServerVer = iServer.GetVersion(sProduct)
|
||||
If sServerVer = vbNullString Then _
|
||||
sServerVer = "íåò äàííûõ"
|
||||
|
||||
With iOut
|
||||
.Cells(nRow, 1) = sProduct
|
||||
.Cells(nRow, 2) = sLocalVer
|
||||
.Cells(nRow, 3) = sServerVer
|
||||
.Cells(nRow, 4) = IIf(iEnabled.CheckProductEnabled(sProduct), "ÄÀ", "ÍÅÒ")
|
||||
End With
|
||||
nRow = nRow + 1
|
||||
Next iProduct
|
||||
End Function
|
||||
|
||||
' =======
|
||||
Private Function ScanProjects(iSource As Excel.Worksheet) As Collection
|
||||
Set ScanProjects = New Collection
|
||||
Dim nRow&
|
||||
Dim lstRow&: lstRow = iSource.Cells(iSource.Rows.Count, 1).End(xlUp).Row
|
||||
nRow = PROJECTS_FIRST_ROW
|
||||
For nRow = PROJECTS_FIRST_ROW To lstRow Step 1
|
||||
Dim sTxt$: sTxt = iSource.Cells(nRow, 1)
|
||||
If sTxt <> vbNullString Then _
|
||||
Call ScanProjects.Add(sTxt)
|
||||
Next nRow
|
||||
End Function
|
||||
20
src/ParametersSearch.cls
Normal file
20
src/ParametersSearch.cls
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ParametersSearch"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public searchWhere_ As Excel.Range
|
||||
Public searchWhat_ As Excel.Range
|
||||
|
||||
Public partialMatch_ As Boolean
|
||||
Public normalize_ As Boolean
|
||||
Public outputText_ As Boolean
|
||||
|
||||
Public ignoreSmall_ As Boolean
|
||||
Public smallSize_ As Long
|
||||
639
src/PublicFunctions.bas
Normal file
639
src/PublicFunctions.bas
Normal file
|
|
@ -0,0 +1,639 @@
|
|||
Attribute VB_Name = "PublicFunctions"
|
||||
' User defined function to use in Cells formula
|
||||
Option Explicit
|
||||
|
||||
Private Const BLANKS_LIMIT = 300
|
||||
|
||||
Public Sub RegisterUDF()
|
||||
Dim xlApp As Excel.Application: Set xlApp = ThisWorkbook.Application
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="RS_ToASCII", Category:="CONCEPT_RS", _
|
||||
Description:="Ïðåîáðàçîâàòü ðîäîñòðóêòóðíûé Unicode â ASCII")
|
||||
Call xlApp.MacroOptions(Macro:="RS_ToMath", Category:="CONCEPT_RS", _
|
||||
Description:="Ïðåîáðàçîâàòü ðîäîñòðóêòóðíûé ASCII â Unicode")
|
||||
Call xlApp.MacroOptions(Macro:="RS_ToTree", Category:="CONCEPT_RS", _
|
||||
Description:="Ðàçîáðàòü ñòðóêòóðó ðîäîñòðóêòóðíîãî ASCII è âûâåñòè äåðåâî ðàçáîðà")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="PY_Parse", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Èçâëå÷ü ìîðôîëîãè÷åñêèå òåãè ñëîâîñî÷åòàíèÿ" & vbNewLine & _
|
||||
"Âòîðîé ïàðàìåòð óêàçûâàåò òåãè, êîòîðûå òî÷íî äîëæíû áûòü â ðàçáîðå")
|
||||
Call xlApp.MacroOptions(Macro:="PY_Normalize", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê íà÷àëüíîé ôîðìå")
|
||||
Call xlApp.MacroOptions(Macro:="PY_Inflect", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå ñ çàäàííûìè òåãàìè")
|
||||
Call xlApp.MacroOptions(Macro:="PY_InflectSubstitute", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, ñîîòâåòñòâóþùåé äðóãîìó ñëîâîñî÷åòàíèþ" & vbNewLine & _
|
||||
"Ïåðâûé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå, ôîðìó êîòîðîãî íåîáõîäèìî èçìåíèòü" & vbNewLine & _
|
||||
"Âòîðîé ïàðàìåòð çàäàåò ýòàëîí")
|
||||
Call xlApp.MacroOptions(Macro:="PY_InflectDependant", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, ñîãëàñîâàííîé ñ óêàçàííûì ñëîâîñî÷åòàíèåì" & vbNewLine & _
|
||||
"Âòîðîé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå, ñ êîòîðûì íåîáõîäèìî ñîãëàñîâàòü öåëåâîå")
|
||||
Call xlApp.MacroOptions(Macro:="PY_InflectContext", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, îïðåäåëÿåìîé åãî îêðóæåíèåì" & vbNewLine & _
|
||||
"Âòîðîé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå ÄÎ öåëåâîãî" & vbNewLine & _
|
||||
"Òðåòèé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå ÏÎÑËÅ öåëåâîãî")
|
||||
Call xlApp.MacroOptions(Macro:="PY_FindSubstr", Category:="CONCEPT_PYTHON", _
|
||||
Description:="Ïðîâåðêà íà ïîäñòðîêó ñ ó÷åòîì ñëîâîôîðì")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_AbbreviateText", Category:="CONCEPT", _
|
||||
Description:="Ïðèìåíèòü ñîêðàùåíèÿ äëÿ ÔÎÈÂ")
|
||||
Call xlApp.MacroOptions(Macro:="CC_TrimWhitespace", Category:="CONCEPT", _
|
||||
Description:="Óäàëèòü ïðîáåëû è ïåðåíîñû â íà÷àëå è êîíöå òåêñòà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_TrimPunctuation", Category:="CONCEPT", _
|
||||
Description:="Óäàëèòü çíàêè ïóíêòóöèè â êîíöå òåêñòà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_SubstituteWhitespace", Category:="CONCEPT", _
|
||||
Description:="Çàìåíèòü âñå ñïåö. ñèìâîëû íà ïðîáåëû")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_CutRight", Category:="CONCEPT", _
|
||||
Description:="Îáðàçàòü òåêñò ñïðàâà îò ïðåâîãî âõîæäåíèÿ ïîäñòðîêè" & vbNewLine & _
|
||||
"cutWhat - îáðåçàåìûé òåêñò" & vbNewLine & _
|
||||
"cutWhere - ñòðîêà-ðàçäåëèòåëü" & vbNewLine & _
|
||||
"[keepDelim=FALSE] - îñòàâëÿòü ðàçäåëèòåëü â èòîãîâîé ñòðîêå")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_CutLeft", Category:="CONCEPT", _
|
||||
Description:="Îáðàçàòü òåêñò ñëåâà îò ïðåâîãî âõîæäåíèÿ ïîäñòðîêè" & vbNewLine & _
|
||||
"cutWhat - îáðåçàåìûé òåêñò" & vbNewLine & _
|
||||
"cutWhere - ñòðîêà-ðàçäåëèòåëü")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_CountColor", Category:="CONCEPT", _
|
||||
Description:="Ïîäñ÷åò êîëè÷åñòâà ÿ÷ååê ñ çàäàííûì öâåòîì" & vbNewLine & _
|
||||
"rData - ìàññèâ ÿ÷ååê äëÿ àíàëèçà" & vbNewLine & _
|
||||
"rCriteria - ÿ÷åéêà, ñîäåðæàùàÿ èñêîìûé öâåò")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_FileMD5", Category:="CONCEPT", _
|
||||
Description:="Âû÷èñëèòü õåø-ñóììó ôàéëà ïî àëãîðèòìó MD5")
|
||||
Call xlApp.MacroOptions(Macro:="CC_FileSHA1", Category:="CONCEPT", _
|
||||
Description:="Âû÷èñëèòü õåø-ñóììó ôàéëà ïî àëãîðèòìó SAH1")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_ExtactFileName", Category:="CONCEPT", _
|
||||
Description:="Âûäåëèòü èìÿ ôàéëà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_ExtactFileNameText", Category:="CONCEPT", _
|
||||
Description:="Âûäåëèòü èìÿ ôàéëà áåç ðàñøèðåíèÿ")
|
||||
Call xlApp.MacroOptions(Macro:="CC_ExtactFileExtension", Category:="CONCEPT", _
|
||||
Description:="Âûäåëèòü ðàñøèðåíèå ôàéëà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_ExtactFolderName", Category:="CONCEPT", _
|
||||
Description:="Âûäåëèòü ïàïêó, ñîäåðæàùóþ ôàéë")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_HyperlinkToString", Category:="CONCEPT", _
|
||||
Description:="Èçâëå÷ü ãèïåðññûëêó êàê òåêñò")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_MatchCount", Category:="CONCEPT", _
|
||||
Description:="Ïîäñ÷èòàòü êîëè÷åñòâî âõîæäåíèé îäíîé ñòðîêè â äðóãóþ")
|
||||
Call xlApp.MacroOptions(Macro:="CC_MatchMultiple", Category:="CONCEPT", _
|
||||
Description:="Îòáîð ïîäìíîæåñòâà èñêîìûõ ñòðîê, âõîäÿùèõ â äàííóþ" & vbNewLine & _
|
||||
"target - öåëåâîé òåêñò" & vbNewLine & _
|
||||
"iMatchList - èñêîìûå òåêñòû" & vbNewLine & _
|
||||
"[nMode=1] - ðåæèì ñðàâíåíèÿ" & vbNewLine & _
|
||||
"1 - (ïî óìîë÷àíèþ) - ñðàâíåíèå áåç èçìåíåíèé" & vbNewLine & _
|
||||
"2 - ïðîáåë ñëåâà" & vbNewLine & _
|
||||
"3 - ïðîáåë ñïðàâà" & vbNewLine & _
|
||||
"4 - ïðîáåë ñëåâà è ñïðàâà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_LookupSubstr", Category:="CONCEPT", _
|
||||
Description:="Àíàëîã ÂÏÐ (HLOOKUP), â êîòîðîì ïîèñê èäåò íå ïî ñîâïàäåíèþ, à ïî ïîäñòðîêå")
|
||||
Call xlApp.MacroOptions(Macro:="CC_LongestDuplicatePrefix", Category:="CONCEPT", _
|
||||
Description:="Ñàìûé äëèííûé ïðåôèêñ, ïîâòîðÿþùèéñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_LongestDuplicateSuffix", Category:="CONCEPT", _
|
||||
Description:="Ñàìûé äëèííûé ñóôôèêñ, ïîâòîðÿþùèéñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà")
|
||||
Call xlApp.MacroOptions(Macro:="CC_SLOW_LongestDuplicateSubstring", Category:="CONCEPT", _
|
||||
Description:="Ñàìàÿ äëèííàÿ ïîäñòðîêà, ïîâòîðÿþùàÿñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà" & vbNewLine & _
|
||||
"Âíèìàíèå! Ïðîèçâîäèòåëüíîñòü î÷åíü ñèëüíî ïàäàåò ñ óâåëè÷åíèåì äëèíû ñòðîêè è êîëè÷åñòâà ñòðîê")
|
||||
|
||||
Call xlApp.MacroOptions(Macro:="CC_LookupMulti", Category:="CONCEPT", _
|
||||
Description:="Ïîèñê çàäàííîãî â ïåðâîì ñòîëáöå àðãóìåíòà 1 íàáîðà ïîäñòðîê â çàäàííîé äëÿ ïîèñêà ñòðîêå àðãóìåíòà 2." & vbNewLine & _
|
||||
"Âîçâðàùàåò òåêñò â ñòîëáöå ñ íîìåðîì = àðãóìåíò 3 â ñòðî÷êå, ñòðîêà ïåðâîãî ñòîëáöà êîòîðîé áûëà íàéäåíà â àðãóìåíòå 2")
|
||||
Call xlApp.MacroOptions(Macro:="CC_LookupMultiCount", Category:="CONCEPT", _
|
||||
Description:="Ïðèíöèï ðàáîòû àíàëîãè÷åí LookupMulti, íî âîçâðàùàåò êîëè÷åñòâî íàéäåííûõ ïîäñòðîê")
|
||||
Call xlApp.MacroOptions(Macro:="CC_LookupMultiAll", Category:="CONCEPT", _
|
||||
Description:="Ïðèíöèï ðàáîòû àíàëîãè÷åí LookupMulti, íî âîçâðàùàåò êîíêàòåíàöèþ ðåçóëüòàòîâ äëÿ âñåõ íàéäåííûõ ïîäñòðîê")
|
||||
End Sub
|
||||
|
||||
Public Sub UnregisterUDF()
|
||||
Call UnregisterMacto("RS_ToASCII")
|
||||
Call UnregisterMacto("RS_ToMath")
|
||||
Call UnregisterMacto("RS_ToTree")
|
||||
Call UnregisterMacto("PY_Parse")
|
||||
Call UnregisterMacto("PY_Normalize")
|
||||
Call UnregisterMacto("PY_Inflect")
|
||||
Call UnregisterMacto("PY_InflectSubstitute")
|
||||
Call UnregisterMacto("PY_InflectContext")
|
||||
Call UnregisterMacto("PY_InflectDependant")
|
||||
Call UnregisterMacto("PY_FindSubstr")
|
||||
Call UnregisterMacto("CC_AbbreviateText")
|
||||
Call UnregisterMacto("CC_TrimWhitespace")
|
||||
Call UnregisterMacto("CC_TrimPunctuation")
|
||||
Call UnregisterMacto("CC_CutRight")
|
||||
Call UnregisterMacto("CC_CutLeft")
|
||||
Call UnregisterMacto("CC_CountColor")
|
||||
Call UnregisterMacto("CC_FileMD5")
|
||||
Call UnregisterMacto("CC_FileSHA1")
|
||||
Call UnregisterMacto("CC_ExtactFileName")
|
||||
Call UnregisterMacto("CC_ExtactFileNameText")
|
||||
Call UnregisterMacto("CC_ExtactFileExtension")
|
||||
Call UnregisterMacto("CC_ExtactFolderName")
|
||||
Call UnregisterMacto("CC_HyperlinkToString")
|
||||
Call UnregisterMacto("CC_SubstituteWhitespace")
|
||||
Call UnregisterMacto("CC_MatchCount")
|
||||
Call UnregisterMacto("CC_MatchMultiple")
|
||||
Call UnregisterMacto("CC_LookupSubstr")
|
||||
Call UnregisterMacto("CC_LongestDuplicatePrefix")
|
||||
Call UnregisterMacto("CC_LongestDuplicateSuffix")
|
||||
Call UnregisterMacto("CC_SLOW_LongestDuplicateSubstring")
|
||||
Call UnregisterMacto("CC_LookupMulti")
|
||||
Call UnregisterMacto("CC_LookupMulti")
|
||||
Call UnregisterMacto("CC_LookupMultiCount")
|
||||
Call UnregisterMacto("CC_LookupMultiAll")
|
||||
End Sub
|
||||
|
||||
Public Function RS_ToASCII(sUnicodeText$) As String
|
||||
Attribute RS_ToASCII.VB_Description = "Ïðåîáðàçîâàòü ðîäîñòðóêòóðíûé Unicode â ASCII"
|
||||
Attribute RS_ToASCII.VB_ProcData.VB_Invoke_Func = " \n20"
|
||||
RS_ToASCII = MathToASCII(sUnicodeText)
|
||||
End Function
|
||||
|
||||
Public Function RS_ToMath(sAsciiText$) As String
|
||||
Attribute RS_ToMath.VB_Description = "Ïðåîáðàçîâàòü ðîäîñòðóêòóðíûé ASCII â Unicode"
|
||||
Attribute RS_ToMath.VB_ProcData.VB_Invoke_Func = " \n20"
|
||||
RS_ToMath = ASCIItoMath(sAsciiText)
|
||||
End Function
|
||||
|
||||
Public Function RS_ToTree(sAsciiText$) As String
|
||||
Attribute RS_ToTree.VB_Description = "Ðàçîáðàòü ñòðóêòóðó ðîäîñòðóêòóðíîãî ASCII è âûâåñòè äåðåâî ðàçáîðà"
|
||||
Attribute RS_ToTree.VB_ProcData.VB_Invoke_Func = " \n20"
|
||||
RS_ToTree = ASCIItoAST(sAsciiText)
|
||||
End Function
|
||||
|
||||
Public Function PY_Parse(sTarget$, Optional sTags$ = "") As String
|
||||
Attribute PY_Parse.VB_Description = "Èçâëå÷ü ìîðôîëîãè÷åñêèå òåãè ñëîâîñî÷åòàíèÿ\r\nÂòîðîé ïàðàìåòð óêàçûâàåò òåãè, êîòîðûå òî÷íî äîëæíû áûòü â ðàçáîðå"
|
||||
Attribute PY_Parse.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_Parse = AccessPython.CallFunction(PY_MODULE_TEXT, "parse", Array(sTarget, sTags))
|
||||
End Function
|
||||
|
||||
Public Function PY_Normalize(sTarget$) As String
|
||||
Attribute PY_Normalize.VB_Description = "Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê íà÷àëüíîé ôîðìå"
|
||||
Attribute PY_Normalize.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_Normalize = AccessPython.CallFunction(PY_MODULE_TEXT, "normalize", Array(sTarget))
|
||||
End Function
|
||||
|
||||
Public Function PY_Inflect(sTarget$, sTags$) As String
|
||||
Attribute PY_Inflect.VB_Description = "Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå ñ çàäàííûìè òåãàìè"
|
||||
Attribute PY_Inflect.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_Inflect = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect", Array(sTarget, sTags))
|
||||
End Function
|
||||
|
||||
Public Function PY_InflectSubstitute(sTarget$, sOriginal$) As String
|
||||
Attribute PY_InflectSubstitute.VB_Description = "Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, ñîîòâåòñòâóþùåé äðóãîìó ñëîâîñî÷åòàíèþ\r\nÏåðâûé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå, ôîðìó êîòîðîãî íåîáõîäèìî èçìåíèòü\r\nÂòîðîé ïàðàìåòð çàäàåò ýòàëîí"
|
||||
Attribute PY_InflectSubstitute.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_InflectSubstitute = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_substitute", Array(sTarget, sOriginal))
|
||||
End Function
|
||||
|
||||
Public Function PY_InflectDependant(sTarget$, sMaster$) As String
|
||||
Attribute PY_InflectDependant.VB_Description = "Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, ñîãëàñîâàííîé ñ óêàçàííûì ñëîâîñî÷åòàíèåì\r\nÂòîðîé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå, ñ êîòîðûì íåîáõîäèìî ñîãëàñîâàòü öåëåâîå"
|
||||
Attribute PY_InflectDependant.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_InflectDependant = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_dependant", Array(sTarget, sMaster))
|
||||
End Function
|
||||
|
||||
Public Function PY_InflectContext(sTarget$, Optional sBefore$ = "", Optional sAfter$ = "") As String
|
||||
Attribute PY_InflectContext.VB_Description = "Ïðåîáðàçîâàòü ñëîâîñî÷åòàíèå ê ôîðìå, îïðåäåëÿåìîé åãî îêðóæåíèåì\r\nÂòîðîé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå ÄÎ öåëåâîãî\r\nÒðåòèé ïàðàìåòð çàäàåò ñëîâîñî÷åòàíèå ÏÎÑËÅ öåëåâîãî"
|
||||
Attribute PY_InflectContext.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
PY_InflectContext = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_context", Array(sTarget, sBefore, sAfter))
|
||||
End Function
|
||||
|
||||
Public Function PY_FindSubstr(sHaystack$, sNeedle$) As String
|
||||
Attribute PY_FindSubstr.VB_Description = "Ïðîâåðêà íà ïîäñòðîêó ñ ó÷åòîì ñëîâîôîðì"
|
||||
Attribute PY_FindSubstr.VB_ProcData.VB_Invoke_Func = " \n21"
|
||||
Dim result As Variant:
|
||||
result = AccessPython.CallFunction(PY_MODULE_TEXT, "find_substr", Array(sHaystack, sNeedle))
|
||||
PY_FindSubstr = Fmt("{1},{2}", result(0), result(1))
|
||||
End Function
|
||||
|
||||
Public Function CC_AbbreviateText(target$) As String
|
||||
Attribute CC_AbbreviateText.VB_Description = "Ïðèìåíèòü ñîêðàùåíèÿ äëÿ ÔÎÈÂ"
|
||||
Attribute CC_AbbreviateText.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_AbbreviateText = ApplyCommonAbbreviations(target)
|
||||
End Function
|
||||
|
||||
Public Function CC_TrimWhitespace(target$) As String
|
||||
Attribute CC_TrimWhitespace.VB_Description = "Óäàëèòü ïðîáåëû è ïåðåíîñû â íà÷àëå è êîíöå òåêñòà"
|
||||
Attribute CC_TrimWhitespace.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_TrimWhitespace = TrimWhitespace(target)
|
||||
End Function
|
||||
|
||||
Public Function CC_TrimPunctuation(target$) As String
|
||||
Attribute CC_TrimPunctuation.VB_Description = "Óäàëèòü çíàêè ïóíêòóöèè â êîíöå òåêñòà"
|
||||
Attribute CC_TrimPunctuation.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_TrimPunctuation = TrimEndPunctuation(target)
|
||||
End Function
|
||||
|
||||
Public Function CC_CutRight(cutWhat$, cutWhere$, Optional keepDelim As Boolean = False) As String
|
||||
Attribute CC_CutRight.VB_Description = "Îáðàçàòü òåêñò ñïðàâà îò ïðåâîãî âõîæäåíèÿ ïîäñòðîêè\r\ncutWhat - îáðåçàåìûé òåêñò\r\ncutWhere - ñòðîêà-ðàçäåëèòåëü\r\n[keepDelim=FALSE] - îñòàâëÿòü ðàçäåëèòåëü â èòîãîâîé ñòðîêå"
|
||||
Attribute CC_CutRight.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
' Ôóíêöèÿ äëÿ âûäåëåíèÿ ïðàâîé ïîäñòðîêè îòíîñèòåëüíî ïåðâîãî âõîæäåíèÿ çàäàííîé ïîäñòðîêè
|
||||
Dim nPos&: nPos = VBA.InStr(1, cutWhat, cutWhere)
|
||||
If nPos = 0 Then _
|
||||
Exit Function
|
||||
If keepDelim Then
|
||||
CC_CutRight = VBA.Right(cutWhat, VBA.Len(cutWhat) - nPos + 1)
|
||||
Else
|
||||
CC_CutRight = VBA.Right(cutWhat, VBA.Len(cutWhat) - nPos + 1 - VBA.Len(cutWhere))
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function CC_CutLeft(cutWhat$, cutWhere$) As String
|
||||
Attribute CC_CutLeft.VB_Description = "Îáðàçàòü òåêñò ñëåâà îò ïðåâîãî âõîæäåíèÿ ïîäñòðîêè\r\ncutWhat - îáðåçàåìûé òåêñò\r\ncutWhere - ñòðîêà-ðàçäåëèòåëü"
|
||||
Attribute CC_CutLeft.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
' Ôóíêöèÿ äëÿ âûäåëåíèÿ ëåâîé ïîäñòðîêè îòíîñèòåëüíî ïåðâîãî âõîæäåíèÿ çàäàííîé ïîäñòðîêè
|
||||
CC_CutLeft = cutWhat
|
||||
Dim nPos&: nPos = VBA.InStr(1, cutWhat, cutWhere)
|
||||
If nPos = 0 Then _
|
||||
Exit Function
|
||||
CC_CutLeft = VBA.Left(cutWhat, nPos - 1)
|
||||
End Function
|
||||
|
||||
Public Function CC_CountColor(rData As Excel.Range, rCriteria As Excel.Range) As Long
|
||||
Attribute CC_CountColor.VB_Description = "Ïîäñ÷åò êîëè÷åñòâà ÿ÷ååê ñ çàäàííûì öâåòîì\r\nrData - ìàññèâ ÿ÷ååê äëÿ àíàëèçà\r\nrCriteria - ÿ÷åéêà, ñîäåðæàùàÿ èñêîìûé öâåò"
|
||||
Attribute CC_CountColor.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim aCell As Excel.Range
|
||||
Dim xcolor&: xcolor = rCriteria.Interior.ColorIndex
|
||||
For Each aCell In rData
|
||||
If aCell.Interior.ColorIndex = xcolor Then _
|
||||
CC_CountColor = CC_CountColor + 1
|
||||
Next aCell
|
||||
End Function
|
||||
|
||||
Public Function CC_FileMD5(sPath$) As String
|
||||
Attribute CC_FileMD5.VB_Description = "Âû÷èñëèòü õåø-ñóììó ôàéëà ïî àëãîðèòìó MD5"
|
||||
Attribute CC_FileMD5.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_FileMD5 = FileToMD5(sPath)
|
||||
If CC_FileMD5 = vbNullString Then _
|
||||
CC_FileMD5 = "File not found"
|
||||
End Function
|
||||
|
||||
Public Function CC_FileSHA1(sPath$) As String
|
||||
Attribute CC_FileSHA1.VB_Description = "Âû÷èñëèòü õåø-ñóììó ôàéëà ïî àëãîðèòìó SAH1"
|
||||
Attribute CC_FileSHA1.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_FileSHA1 = FileToSHA1(sPath)
|
||||
If CC_FileSHA1 = vbNullString Then _
|
||||
CC_FileSHA1 = "File not found"
|
||||
End Function
|
||||
|
||||
Public Function CC_ExtactFileName(sPath$) As String
|
||||
Attribute CC_ExtactFileName.VB_Description = "Âûäåëèòü èìÿ ôàéëà"
|
||||
Attribute CC_ExtactFileName.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
CC_ExtactFileName = fso.GetFileName(sPath)
|
||||
End Function
|
||||
|
||||
Public Function CC_ExtactFileNameText(sPath$) As String
|
||||
Attribute CC_ExtactFileNameText.VB_Description = "Âûäåëèòü èìÿ ôàéëà áåç ðàñøèðåíèÿ"
|
||||
Attribute CC_ExtactFileNameText.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
CC_ExtactFileNameText = fso.GetBaseName(sPath)
|
||||
End Function
|
||||
|
||||
Public Function CC_ExtactFileExtension(sPath$) As String
|
||||
Attribute CC_ExtactFileExtension.VB_Description = "Âûäåëèòü ðàñøèðåíèå ôàéëà"
|
||||
Attribute CC_ExtactFileExtension.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
CC_ExtactFileExtension = fso.GetExtensionName(sPath)
|
||||
End Function
|
||||
|
||||
Public Function CC_ExtactFolderName(sPath$) As String
|
||||
Attribute CC_ExtactFolderName.VB_Description = "Âûäåëèòü ïàïêó, ñîäåðæàùóþ ôàéë"
|
||||
Attribute CC_ExtactFolderName.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
CC_ExtactFolderName = fso.GetParentFolderName(sPath)
|
||||
End Function
|
||||
|
||||
Public Function CC_HyperlinkToString(aCell As Excel.Range) As String
|
||||
Attribute CC_HyperlinkToString.VB_Description = "Èçâëå÷ü ãèïåðññûëêó êàê òåêñò"
|
||||
Attribute CC_HyperlinkToString.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
If aCell.Hyperlinks.Count > 0 Then
|
||||
With aCell.Hyperlinks(1)
|
||||
CC_HyperlinkToString = .Address
|
||||
If .SubAddress <> vbNullString Then _
|
||||
CC_HyperlinkToString = CC_HyperlinkToString + "#" + .SubAddress
|
||||
End With
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function CC_SubstituteWhitespace(target$) As String
|
||||
Attribute CC_SubstituteWhitespace.VB_Description = "Çàìåíèòü âñå ñïåö. ñèìâîëû íà ïðîáåëû"
|
||||
Attribute CC_SubstituteWhitespace.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_SubstituteWhitespace = SubstituteWhitespace(target)
|
||||
End Function
|
||||
|
||||
Public Function CC_MatchCount(target$, iMatch$) As Long
|
||||
Attribute CC_MatchCount.VB_Description = "Ïîäñ÷èòàòü êîëè÷åñòâî âõîæäåíèé îäíîé ñòðîêè â äðóãóþ"
|
||||
Attribute CC_MatchCount.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
CC_MatchCount = (VBA.Len(target) - VBA.Len(VBA.Replace(target, iMatch, "", Compare:=vbTextCompare))) / VBA.Len(iMatch)
|
||||
End Function
|
||||
|
||||
Public Function CC_MatchMultiple(target$, iMatchList As Excel.Range, Optional nMode As TMatchMode = T_MM_DEFAULT) As String
|
||||
Attribute CC_MatchMultiple.VB_Description = "Îòáîð ïîäìíîæåñòâà èñêîìûõ ñòðîê, âõîäÿùèõ â äàííóþ\r\ntarget - öåëåâîé òåêñò\r\niMatchList - èñêîìûå òåêñòû\r\n[nMode=1] - ðåæèì ñðàâíåíèÿ\r\n1 - (ïî óìîë÷àíèþ) - ñðàâíåíèå áåç èçìåíåíèé\r\n2 - ïðîáåë ñëåâà\r\n3 - ïðîáåë ñïðàâà\r\n4 - ïðîáåë ñëåâà è ñïðàâà"
|
||||
Attribute CC_MatchMultiple.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim aCell As Excel.Range
|
||||
Dim sMatch$
|
||||
Dim sTarget$: sTarget = ApplyMatchMode(target, nMode)
|
||||
For Each aCell In iMatchList
|
||||
Dim sText$: sText = ApplyMatchMode(aCell.Text, nMode)
|
||||
If VBA.InStr(1, sTarget, sText, vbTextCompare) <> 0 Then
|
||||
If sMatch <> vbNullString Then _
|
||||
sMatch = sMatch & ";"
|
||||
sMatch = sMatch & aCell
|
||||
End If
|
||||
Next aCell
|
||||
CC_MatchMultiple = sMatch
|
||||
End Function
|
||||
|
||||
Public Function CC_LookupSubstr(sSearch$, iData As Excel.Range, nColumn&) As Variant
|
||||
Attribute CC_LookupSubstr.VB_Description = "Àíàëîã ÂÏÐ (HLOOKUP), â êîòîðîì ïîèñê èäåò íå ïî ñîâïàäåíèþ, à ïî ïîäñòðîêå"
|
||||
Attribute CC_LookupSubstr.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
If nColumn > iData.Columns.Count Then
|
||||
CC_LookupSubstr = CVErr(xlErrValue)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim aCell As Excel.Range
|
||||
Dim nBlank&: nBlank = 0
|
||||
For Each aCell In iData.Columns(1).Cells
|
||||
Dim sText$: sText = aCell.Text
|
||||
If sText = "" Then
|
||||
nBlank = nBlank + 1
|
||||
If nBlank > BLANKS_LIMIT Then _
|
||||
Exit Function
|
||||
Else
|
||||
nBlank = 0
|
||||
End If
|
||||
|
||||
If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
|
||||
CC_LookupSubstr = aCell.Offset(0, nColumn - 1).Text
|
||||
Exit Function
|
||||
End If
|
||||
Next aCell
|
||||
End Function
|
||||
|
||||
Public Function CC_LongestDuplicateSuffix(iData As Excel.Range, Optional nMaxLen& = 1000) As String
|
||||
Attribute CC_LongestDuplicateSuffix.VB_Description = "Ñàìûé äëèííûé ñóôôèêñ, ïîâòîðÿþùèéñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà"
|
||||
Attribute CC_LongestDuplicateSuffix.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim arrValue As Variant
|
||||
arrValue = iData.Value
|
||||
If ArraySize(arrValue, 2) <> 1 Then
|
||||
CC_LongestDuplicateSuffix = CVErr(xlErrValue)
|
||||
Exit Function
|
||||
End If
|
||||
If ArraySize(arrValue, 1) = 1 Then
|
||||
CC_LongestDuplicateSuffix = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
|
||||
Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
|
||||
Dim nItem&
|
||||
Dim nOut&: nOut = 1
|
||||
Dim sCurrent$
|
||||
Dim nCurrentLen&: nCurrentLen = 0
|
||||
For nItem = 1 To UBound(arrValue)
|
||||
sInputs(nOut) = VBA.Right$(CStr(arrValue(nItem, 1)), nMaxLen)
|
||||
nLens(nOut) = VBA.Len(sInputs(nOut))
|
||||
If nLens(nOut) <= nCurrentLen Then _
|
||||
GoTo NEXT_ITEM
|
||||
If nOut = 1 Then
|
||||
nOut = nOut + 1
|
||||
GoTo NEXT_ITEM
|
||||
End If
|
||||
|
||||
Dim nCompare&
|
||||
For nCompare = 1 To nOut - 1 Step 1
|
||||
If nLens(nCompare) <= nCurrentLen Then _
|
||||
GoTo NEXT_COMPARE
|
||||
If VBA.Right$(sInputs(nOut), nCurrentLen + 1) <> VBA.Right$(sInputs(nCompare), nCurrentLen + 1) Then _
|
||||
GoTo NEXT_COMPARE
|
||||
|
||||
Do
|
||||
nCurrentLen = nCurrentLen + 1
|
||||
If nLens(nCompare) <= nCurrentLen Or nLens(nOut) <= nCurrentLen Then _
|
||||
Exit Do
|
||||
If VBA.Mid$(sInputs(nOut), nLens(nOut) - nCurrentLen, 1) <> VBA.Mid$(sInputs(nCompare), nLens(nCompare) - nCurrentLen, 1) Then _
|
||||
Exit Do
|
||||
Loop
|
||||
|
||||
sCurrent = VBA.Right$(sInputs(nOut), nCurrentLen)
|
||||
NEXT_COMPARE:
|
||||
Next nCompare
|
||||
|
||||
nOut = nOut + 1
|
||||
NEXT_ITEM:
|
||||
Next nItem
|
||||
|
||||
CC_LongestDuplicateSuffix = sCurrent
|
||||
End Function
|
||||
|
||||
Public Function CC_LongestDuplicatePrefix(iData As Excel.Range, Optional nMaxLen& = 1000) As String
|
||||
Attribute CC_LongestDuplicatePrefix.VB_Description = "Ñàìûé äëèííûé ïðåôèêñ, ïîâòîðÿþùèéñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà"
|
||||
Attribute CC_LongestDuplicatePrefix.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim arrValue As Variant
|
||||
arrValue = iData.Value
|
||||
If ArraySize(arrValue, 2) <> 1 Then
|
||||
CC_LongestDuplicatePrefix = CVErr(xlErrValue)
|
||||
Exit Function
|
||||
End If
|
||||
If ArraySize(arrValue, 1) = 1 Then
|
||||
CC_LongestDuplicatePrefix = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
|
||||
Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
|
||||
Dim nItem&
|
||||
Dim nOut&: nOut = 1
|
||||
Dim sCurrent$
|
||||
Dim nCurrentLen&: nCurrentLen = 0
|
||||
For nItem = 1 To UBound(arrValue)
|
||||
sInputs(nOut) = VBA.Left$(CStr(arrValue(nItem, 1)), nMaxLen)
|
||||
nLens(nOut) = VBA.Len(sInputs(nOut))
|
||||
If nLens(nOut) <= nCurrentLen Then _
|
||||
GoTo NEXT_ITEM
|
||||
If nOut = 1 Then
|
||||
nOut = nOut + 1
|
||||
GoTo NEXT_ITEM
|
||||
End If
|
||||
|
||||
Dim nCompare&
|
||||
For nCompare = 1 To nOut - 1 Step 1
|
||||
If nLens(nCompare) <= nCurrentLen Then _
|
||||
GoTo NEXT_COMPARE
|
||||
If VBA.Left$(sInputs(nOut), nCurrentLen + 1) <> VBA.Left$(sInputs(nCompare), nCurrentLen + 1) Then _
|
||||
GoTo NEXT_COMPARE
|
||||
|
||||
Do
|
||||
nCurrentLen = nCurrentLen + 1
|
||||
If nLens(nCompare) <= nCurrentLen Or nLens(nOut) <= nCurrentLen Then _
|
||||
Exit Do
|
||||
If VBA.Mid$(sInputs(nOut), nCurrentLen + 1, 1) <> VBA.Mid$(sInputs(nCompare), nCurrentLen + 1, 1) Then _
|
||||
Exit Do
|
||||
Loop
|
||||
|
||||
sCurrent = VBA.Left$(sInputs(nOut), nCurrentLen)
|
||||
NEXT_COMPARE:
|
||||
Next nCompare
|
||||
|
||||
nOut = nOut + 1
|
||||
NEXT_ITEM:
|
||||
Next nItem
|
||||
|
||||
CC_LongestDuplicatePrefix = sCurrent
|
||||
End Function
|
||||
|
||||
Public Function CC_SLOW_LongestDuplicateSubstring(iData As Excel.Range) As String
|
||||
Attribute CC_SLOW_LongestDuplicateSubstring.VB_Description = "Ñàìàÿ äëèííàÿ ïîäñòðîêà, ïîâòîðÿþùàÿñÿ õîòÿ áû â 2 ñòðîêàõ èç çàäàíîãî íàáîðà\r\nÂíèìàíèå! Ïðîèçâîäèòåëüíîñòü î÷åíü ñèëüíî ïàäàåò ñ óâåëè÷åíèåì äëèíû ñòðîêè è êîëè÷åñòâà ñòðîê"
|
||||
Attribute CC_SLOW_LongestDuplicateSubstring.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim arrValue As Variant
|
||||
arrValue = iData.Value
|
||||
If ArraySize(arrValue, 2) <> 1 Then
|
||||
CC_SLOW_LongestDuplicateSubstring = "ERR"
|
||||
Exit Function
|
||||
End If
|
||||
If ArraySize(arrValue, 1) = 1 Then
|
||||
CC_SLOW_LongestDuplicateSubstring = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
|
||||
Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
|
||||
Dim nItem&
|
||||
For nItem = 1 To UBound(arrValue)
|
||||
sInputs(nItem) = CStr(arrValue(nItem, 1))
|
||||
nLens(nItem) = VBA.Len(sInputs(nItem))
|
||||
Next nItem
|
||||
|
||||
CC_SLOW_LongestDuplicateSubstring = RunLCS(sInputs, nLens)
|
||||
End Function
|
||||
|
||||
Public Function CC_LookupMulti(iData As Excel.Range, sText$, nResultColumn&) As Variant
|
||||
Attribute CC_LookupMulti.VB_Description = "Ïîèñê çàäàííîãî â ïåðâîì ñòîëáöå àðãóìåíòà 1 íàáîðà ïîäñòðîê â çàäàííîé äëÿ ïîèñêà ñòðîêå àðãóìåíòà 2.\r\nÂîçâðàùàåò òåêñò â ñòîëáöå ñ íîìåðîì = àðãóìåíò 3 â ñòðî÷êå, ñòðîêà ïåðâîãî ñòîëáöà êîòîðîé áûëà íàéäåíà â àðãóìåíòå 2"
|
||||
Attribute CC_LookupMulti.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
If nResultColumn > iData.Columns.Count Then
|
||||
CC_LookupMulti = CVErr(xlErrValue)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim aCell As Excel.Range
|
||||
Dim nBlank&: nBlank = 0
|
||||
For Each aCell In iData.Columns(1).Cells
|
||||
Dim sSearch$: sSearch = aCell.Text
|
||||
If sSearch = "" Then
|
||||
nBlank = nBlank + 1
|
||||
If nBlank > BLANKS_LIMIT Then _
|
||||
Exit Function
|
||||
Else
|
||||
nBlank = 0
|
||||
End If
|
||||
|
||||
If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
|
||||
CC_LookupMulti = aCell.Offset(0, nResultColumn - 1).Text
|
||||
Exit Function
|
||||
End If
|
||||
Next aCell
|
||||
CC_LookupMulti = ""
|
||||
End Function
|
||||
|
||||
Public Function CC_LookupMultiCount(iData As Excel.Range, sText$) As Variant
|
||||
Attribute CC_LookupMultiCount.VB_Description = "Ïðèíöèï ðàáîòû àíàëîãè÷åí LookupMulti, íî âîçâðàùàåò êîëè÷åñòâî íàéäåííûõ ïîäñòðîê"
|
||||
Attribute CC_LookupMultiCount.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
Dim aCell As Excel.Range
|
||||
Dim nBlank&: nBlank = 0
|
||||
CC_LookupMultiCount = 0
|
||||
For Each aCell In iData.Columns(1).Cells
|
||||
Dim sSearch$: sSearch = aCell.Text
|
||||
If sSearch = "" Then
|
||||
nBlank = nBlank + 1
|
||||
If nBlank > BLANKS_LIMIT Then _
|
||||
Exit Function
|
||||
Else
|
||||
nBlank = 0
|
||||
End If
|
||||
|
||||
If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
|
||||
CC_LookupMultiCount = CC_LookupMultiCount + 1
|
||||
End If
|
||||
Next aCell
|
||||
End Function
|
||||
|
||||
Public Function CC_LookupMultiAll(iData As Excel.Range, sText$, nResultColumn&) As Variant
|
||||
Attribute CC_LookupMultiAll.VB_Description = "Ïðèíöèï ðàáîòû àíàëîãè÷åí LookupMulti, íî âîçâðàùàåò êîíêàòåíàöèþ ðåçóëüòàòîâ äëÿ âñåõ íàéäåííûõ ïîäñòðîê"
|
||||
Attribute CC_LookupMultiAll.VB_ProcData.VB_Invoke_Func = " \n22"
|
||||
If nResultColumn > iData.Columns.Count Then
|
||||
CC_LookupMultiAll = CVErr(xlErrValue)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim aCell As Excel.Range
|
||||
Dim nBlank&: nBlank = 0
|
||||
CC_LookupMultiAll = ""
|
||||
For Each aCell In iData.Columns(1).Cells
|
||||
Dim sSearch$: sSearch = aCell.Text
|
||||
If sSearch = "" Then
|
||||
nBlank = nBlank + 1
|
||||
If nBlank > BLANKS_LIMIT Then _
|
||||
Exit Function
|
||||
Else
|
||||
nBlank = 0
|
||||
End If
|
||||
|
||||
If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
|
||||
If CC_LookupMultiAll <> "" Then _
|
||||
CC_LookupMultiAll = CC_LookupMultiAll & ";"
|
||||
CC_LookupMultiAll = CC_LookupMultiAll & aCell.Offset(0, nResultColumn - 1)
|
||||
End If
|
||||
Next aCell
|
||||
End Function
|
||||
|
||||
' =======
|
||||
Private Function UnregisterMacto(sMacro$)
|
||||
On Error Resume Next
|
||||
Call Excel.Application.MacroOptions(Macro:=sMacro, Category:=Empty, Description:=Empty)
|
||||
End Function
|
||||
|
||||
Private Function ApplyMatchMode(sText$, nMode As TMatchMode) As String
|
||||
Select Case nMode
|
||||
Case T_MM_DEFAULT: ApplyMatchMode = sText
|
||||
Case T_MM_SPACE_LEFT: ApplyMatchMode = " " & sText
|
||||
Case T_MM_SPACE_RIGHT: ApplyMatchMode = sText & " "
|
||||
Case T_MM_SPACE_BOTH: ApplyMatchMode = " " & sText & " "
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Private Function RunLCS(sInputs() As String, nLens() As Long) As String
|
||||
Dim sCurrent$
|
||||
Dim nCurrentLen&: nCurrentLen = 0
|
||||
|
||||
Dim nSample&
|
||||
For nSample = 1 To UBound(sInputs) - 1 Step 1
|
||||
Dim nSampleLen&: nSampleLen = nLens(nSample)
|
||||
If nSampleLen <= nCurrentLen Then _
|
||||
GoTo NEXT_SAMPLE
|
||||
|
||||
Dim nSubstr&
|
||||
Dim nPos&
|
||||
Dim nCompare&
|
||||
For nSubstr = nSampleLen To nCurrentLen + 1 Step -1
|
||||
For nPos = 1 To nSampleLen - nSubstr + 1 Step 1
|
||||
Dim sSample$: sSample = VBA.Mid$(sInputs(nSample), nPos, nSampleLen)
|
||||
For nCompare = nSample + 1 To UBound(sInputs) Step 1
|
||||
If nLens(nCompare) < nSampleLen Then _
|
||||
GoTo NEXT_COMPARE
|
||||
Dim nFound&: nFound = VBA.InStr(nPos, sInputs(nCompare), sSample, vbTextCompare)
|
||||
If nFound <> 0 Then
|
||||
nCurrentLen = nSubstr
|
||||
sCurrent = sSample
|
||||
GoTo NEXT_SAMPLE
|
||||
End If
|
||||
NEXT_COMPARE:
|
||||
Next nCompare
|
||||
Next nPos
|
||||
Next nSubstr
|
||||
NEXT_SAMPLE:
|
||||
Next nSample
|
||||
|
||||
RunLCS = sCurrent
|
||||
End Function
|
||||
78
src/RelocateDlg.frm
Normal file
78
src/RelocateDlg.frm
Normal file
|
|
@ -0,0 +1,78 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} RelocateDlg
|
||||
Caption = "Ïåðåíîñ ôàéëîâ ïî ññûëêàì"
|
||||
ClientHeight = 1740
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 6840
|
||||
OleObjectBlob = "RelocateDlg.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "RelocateDlg"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private prefixInit_ As String
|
||||
Private fso_ As Scripting.FileSystemObject
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
Set fso_ = New Scripting.FileSystemObject
|
||||
End Sub
|
||||
|
||||
Public Function Init(sFilesLocation$)
|
||||
prefixInit_ = sFilesLocation
|
||||
End Function
|
||||
|
||||
Public Property Get Path() As String
|
||||
Path = TBTargetPath.Text
|
||||
End Property
|
||||
|
||||
Public Property Get Prefix() As String
|
||||
Prefix = TBPrefix.Text
|
||||
End Property
|
||||
|
||||
' ====== Internal API
|
||||
Private Sub OkBtn_Click()
|
||||
If Not ValidateData Then
|
||||
Call UserInteraction.ShowMessage(EM_RELOCATE_DATA_FAIL)
|
||||
Else
|
||||
isCancelled_ = False
|
||||
Call Me.Hide
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub CancelBtn_Click()
|
||||
isCancelled_ = True
|
||||
Call Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub BtnPrefix_Click()
|
||||
Dim sFolder$: sFolder = UserInteraction.PromptFolder(prefixInit_ & "\")
|
||||
If sFolder <> vbNullString Then _
|
||||
TBPrefix.Text = sFolder
|
||||
End Sub
|
||||
|
||||
Private Sub BtnTargetPath_Click()
|
||||
Dim sFolder$: sFolder = UserInteraction.PromptFolder(ThisWorkbook.Path & "\")
|
||||
If sFolder <> vbNullString Then _
|
||||
TBTargetPath.Text = sFolder
|
||||
End Sub
|
||||
|
||||
' =====
|
||||
Private Function ValidateData() As Boolean
|
||||
ValidateData = False
|
||||
|
||||
Dim sPath$: sPath = Path
|
||||
If sPath = vbNullString Then _
|
||||
Exit Function
|
||||
If Not fso_.FolderExists(sPath) Then _
|
||||
Exit Function
|
||||
|
||||
ValidateData = True
|
||||
End Function
|
||||
BIN
src/RelocateDlg.frx
Normal file
BIN
src/RelocateDlg.frx
Normal file
Binary file not shown.
96
src/SearchDlg.frm
Normal file
96
src/SearchDlg.frm
Normal file
|
|
@ -0,0 +1,96 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} SearchDlg
|
||||
Caption = "Ïîèñê ñëîâîñî÷åòàíèé"
|
||||
ClientHeight = 5370
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 4575
|
||||
OleObjectBlob = "SearchDlg.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "SearchDlg"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private dataSource_ As Excel.Workbook
|
||||
|
||||
Public Function Init(targetWB As Excel.Workbook)
|
||||
isCancelled_ = True
|
||||
Set dataSource_ = targetWB
|
||||
End Function
|
||||
|
||||
Public Function ResultParams() As ParametersSearch
|
||||
Set ResultParams = New ParametersSearch
|
||||
With ResultParams
|
||||
.ignoreSmall_ = CBIgnoreWords.Value
|
||||
.partialMatch_ = Not CBFindWhole.Value
|
||||
.normalize_ = CBNormalize.Value
|
||||
.outputText_ = CBOutputText.Value
|
||||
.smallSize_ = TBSymbolLimit.Value
|
||||
Set .searchWhere_ = Excel.Range(TBSearchRange.Text)
|
||||
Set .searchWhat_ = Excel.Range(TBQueryRange.Text)
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Sub BtnCancel_Click()
|
||||
isCancelled_ = True
|
||||
Call Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub BtnOK_Click()
|
||||
If Not ValidateData Then
|
||||
Call UserInteraction.ShowMessage(EM_DIALOG_DATA_INVALID)
|
||||
Else
|
||||
isCancelled_ = False
|
||||
Call Me.Hide
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub BtnSearchRange_Click()
|
||||
Call Me.Hide
|
||||
|
||||
Dim iRange As Excel.Range
|
||||
On Error Resume Next
|
||||
Set iRange = Excel.Application.InputBox( _
|
||||
Title:="Âûáîð äèàïàçîíà ÿ÷ååê", _
|
||||
Prompt:="Óêàæèòå äèàïàçîí, â êîòîðîì áóäåò ïðîõîäèòü ïîèñê", _
|
||||
Type:=8)
|
||||
On Error GoTo 0
|
||||
|
||||
If Not iRange Is Nothing Then _
|
||||
TBSearchRange.Text = iRange.Address(External:=True)
|
||||
|
||||
Call Me.Show
|
||||
End Sub
|
||||
|
||||
Private Sub BtnQueryRange_Click()
|
||||
Call Me.Hide
|
||||
|
||||
Dim iRange As Excel.Range
|
||||
On Error Resume Next
|
||||
Set iRange = Excel.Application.InputBox( _
|
||||
Title:="Âûáîð äèàïàçîíà ÿ÷ååê", _
|
||||
Prompt:="Óêàæèòå äèàïàçîí, ñîäåðæàùèé èñêîìûå ôðàçû", _
|
||||
Type:=8)
|
||||
On Error GoTo 0
|
||||
|
||||
If Not iRange Is Nothing Then _
|
||||
TBQueryRange.Text = iRange.Address(External:=True)
|
||||
|
||||
Call Me.Show
|
||||
End Sub
|
||||
|
||||
' ========
|
||||
Private Function ValidateData() As Boolean
|
||||
ValidateData = False
|
||||
If TBQueryRange.Text = vbNullString Then _
|
||||
Exit Function
|
||||
If TBSearchRange.Text = vbNullString Then _
|
||||
Exit Function
|
||||
ValidateData = True
|
||||
End Function
|
||||
BIN
src/SearchDlg.frx
Normal file
BIN
src/SearchDlg.frx
Normal file
Binary file not shown.
267
src/SearchEngine.cls
Normal file
267
src/SearchEngine.cls
Normal file
|
|
@ -0,0 +1,267 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "SearchEngine"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private out_ As Excel.Worksheet
|
||||
Private params_ As ParametersSearch
|
||||
|
||||
Private queryWords_ As Scripting.Dictionary
|
||||
Private queryCount_ As Long
|
||||
|
||||
Private foundIDs_() As Collection
|
||||
Private wordCounts_() As Long
|
||||
|
||||
Private Const PROGRESS_DICTIONARY = 10
|
||||
Private Const PROGRESS_SEARCH = 89
|
||||
Private Const PROGRESS_RESULTS = 1
|
||||
|
||||
Private Const MAX_COLUMNS = 250
|
||||
|
||||
' _SR_ - search results
|
||||
Private Enum SearchResultStruct
|
||||
[_First] = 1
|
||||
|
||||
S_SR_INPUT = 1
|
||||
S_SR_COUNT = 2
|
||||
S_SR_DATA = 3
|
||||
|
||||
[_Last] = 3
|
||||
End Enum
|
||||
|
||||
Public Function Init(iOut As Excel.Worksheet, params As ParametersSearch)
|
||||
Set out_ = iOut
|
||||
Set params_ = params
|
||||
If Not params_.ignoreSmall_ Then _
|
||||
params_.smallSize_ = 0
|
||||
End Function
|
||||
|
||||
Public Function Execute()
|
||||
Call CSE_ProgressBar.Init("Ïîñëîâíûé ïîèñê", maxVal:=100, canInterrupt:=True)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
CSE_ProgressBar.Description = "Ôîðìèðîâàíèå ñëîâàðÿ èç çàïðîñîâ..."
|
||||
Call PrepareIndexDictionary
|
||||
|
||||
CSE_ProgressBar.Description = "Ïîèñê..."
|
||||
Call ExecuteSearch
|
||||
|
||||
CSE_ProgressBar.Description = "Ñîõðàíåíèå ðåçóëüòàòîâ..."
|
||||
Call FinalizeResults
|
||||
Call CSE_ProgressBar.IncrementA(PROGRESS_RESULTS)
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
End Function
|
||||
|
||||
' ========
|
||||
Private Function PrepareIndexDictionary()
|
||||
queryCount_ = CountNonEmpty(params_.searchWhat_)
|
||||
Call ResetWordCounts
|
||||
Call CSE_ProgressBar.InitSecondBar(maxVal:=queryCount_)
|
||||
|
||||
Set queryWords_ = New Scripting.Dictionary
|
||||
Dim nItem&: nItem = 1
|
||||
Dim iCell As Excel.Range
|
||||
Dim iWords As Collection
|
||||
For Each iCell In params_.searchWhat_
|
||||
Set iWords = ExtractWords(iCell.Text)
|
||||
wordCounts_(nItem) = iWords.Count
|
||||
|
||||
Dim iWord As Variant
|
||||
For Each iWord In iWords
|
||||
If params_.normalize_ Then _
|
||||
iWord = PY_Normalize(CStr(iWord))
|
||||
If Not queryWords_.Exists(CStr(iWord)) Then _
|
||||
Set queryWords_(CStr(iWord)) = New Collection
|
||||
On Error Resume Next
|
||||
Call queryWords_(CStr(iWord)).Add(nItem, CStr(nItem))
|
||||
On Error GoTo 0
|
||||
Next iWord
|
||||
|
||||
If nItem = queryCount_ Then _
|
||||
Exit For
|
||||
nItem = nItem + 1
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Call CSE_ProgressBar.SetA(PROGRESS_DICTIONARY * nItem / queryCount_)
|
||||
Next iCell
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ExecuteSearch()
|
||||
Dim nTextCount&: nTextCount = CountNonEmpty(params_.searchWhere_)
|
||||
Call ResetFoundIDs
|
||||
Call CSE_ProgressBar.InitSecondBar(maxVal:=nTextCount)
|
||||
|
||||
Dim nItem&: nItem = 1
|
||||
Dim iCell As Excel.Range
|
||||
Dim iWords As Collection
|
||||
Dim iCounts As Scripting.Dictionary
|
||||
Dim vQueryID As Variant
|
||||
Dim iWord As Variant
|
||||
|
||||
For Each iCell In params_.searchWhere_
|
||||
Set iCounts = New Scripting.Dictionary
|
||||
Set iWords = ExtractWords(iCell.Text)
|
||||
|
||||
For Each iWord In iWords
|
||||
If params_.normalize_ Then _
|
||||
iWord = PY_Normalize(CStr(iWord))
|
||||
If queryWords_.Exists(CStr(iWord)) Then
|
||||
For Each vQueryID In queryWords_(CStr(iWord))
|
||||
If Not iCounts.Exists(CStr(vQueryID)) Then _
|
||||
iCounts(CStr(vQueryID)) = 0
|
||||
iCounts(CStr(vQueryID)) = iCounts(CStr(vQueryID)) + 1
|
||||
Next vQueryID
|
||||
End If
|
||||
Next iWord
|
||||
|
||||
For Each vQueryID In iCounts.Keys
|
||||
If params_.partialMatch_ Or wordCounts_(CLng(vQueryID)) <= iCounts(vQueryID) Then _
|
||||
Call foundIDs_(CLng(vQueryID)).Add(nItem, CStr(nItem))
|
||||
Next vQueryID
|
||||
|
||||
If CSE_ProgressBar.Interrupted Or nItem = nTextCount Then _
|
||||
Exit For
|
||||
nItem = nItem + 1
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Call CSE_ProgressBar.SetA(PROGRESS_DICTIONARY + PROGRESS_SEARCH * nItem / nTextCount)
|
||||
Next iCell
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function FinalizeResults()
|
||||
Call CSE_ProgressBar.InitSecondBar(maxVal:=queryCount_)
|
||||
|
||||
Dim nItem&: nItem = 1
|
||||
Dim nCount&
|
||||
|
||||
Dim iCell As Excel.Range
|
||||
For Each iCell In params_.searchWhat_
|
||||
nCount = foundIDs_(nItem).Count
|
||||
out_.Cells(nItem, S_SR_INPUT) = iCell
|
||||
out_.Cells(nItem, S_SR_COUNT) = foundIDs_(nItem).Count
|
||||
If nCount = 0 Then _
|
||||
GoTo NEXT_ITEM
|
||||
|
||||
If params_.outputText_ Then
|
||||
Call OutputWords(nItem)
|
||||
Else
|
||||
out_.Cells(nItem, 3) = ListIDs(nItem)
|
||||
End If
|
||||
|
||||
NEXT_ITEM:
|
||||
If nItem = queryCount_ Then _
|
||||
Exit For
|
||||
nItem = nItem + 1
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next iCell
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ExtractWords(sText$) As Collection
|
||||
Dim iWords As New Collection
|
||||
Dim nStart&: nStart = 1
|
||||
Dim nLen&: nLen = VBA.Len(sText)
|
||||
Dim nCur&: nCur = nStart
|
||||
Do While nCur <= nLen
|
||||
If IsDelim(VBA.Mid$(sText, nCur, 1)) Then
|
||||
If nCur > nStart And nCur - nStart >= params_.smallSize_ Then _
|
||||
Call iWords.Add(VBA.Mid$(sText, nStart, nCur - nStart))
|
||||
nStart = nCur + 1
|
||||
End If
|
||||
nCur = nCur + 1
|
||||
Loop
|
||||
|
||||
If nCur > nStart And nCur - nStart >= params_.smallSize_ Then _
|
||||
Call iWords.Add(VBA.Mid$(sText, nStart, nCur - nStart))
|
||||
Set ExtractWords = iWords
|
||||
End Function
|
||||
|
||||
Private Function ResetFoundIDs()
|
||||
ReDim foundIDs_(1 To queryCount_)
|
||||
Dim nItem&
|
||||
For nItem = 1 To queryCount_ Step 1
|
||||
Set foundIDs_(nItem) = New Collection
|
||||
Next nItem
|
||||
End Function
|
||||
|
||||
Private Function ResetWordCounts()
|
||||
ReDim wordCounts_(1 To queryCount_)
|
||||
End Function
|
||||
|
||||
Private Function CountNonEmpty(target As Excel.Range) As Long
|
||||
Dim emptyIndex&: emptyIndex = XLFirstEmptyCell(target)
|
||||
If emptyIndex = -1 Then
|
||||
CountNonEmpty = target.Count
|
||||
Else
|
||||
CountNonEmpty = emptyIndex - 1
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function ListIDs(nItem&) As String
|
||||
ListIDs = ""
|
||||
Dim vID As Variant
|
||||
For Each vID In foundIDs_(nItem)
|
||||
If ListIDs <> "" Then _
|
||||
ListIDs = ListIDs & ", "
|
||||
ListIDs = ListIDs & CStr(vID)
|
||||
Next vID
|
||||
End Function
|
||||
|
||||
Private Function OutputWords(nItem&)
|
||||
Dim nColumn&: nColumn = S_SR_DATA
|
||||
Dim vID As Variant
|
||||
For Each vID In foundIDs_(nItem)
|
||||
out_.Cells(nItem, nColumn) = params_.searchWhere_(CLng(vID))
|
||||
nColumn = nColumn + 1
|
||||
If nColumn >= MAX_COLUMNS Then _
|
||||
Exit For
|
||||
Next vID
|
||||
End Function
|
||||
|
||||
Private Function IsDelim(sSymbol$) As Boolean
|
||||
IsDelim = True
|
||||
If sSymbol = Chr(13) Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = Chr(10) Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = "," Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = ChrW(&H2013) Then _
|
||||
Exit Function
|
||||
ElseIf sSymbol = ChrW(&H2012) Then _
|
||||
Exit Function
|
||||
ElseIf sSymbol = ChrW(&H2010) Then _
|
||||
Exit Function
|
||||
ElseIf sSymbol = ";" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = " " Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = "!" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = ":" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = "?" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = """" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = ")" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = "(" Then
|
||||
Exit Function
|
||||
ElseIf sSymbol = "Chr(85)" Then
|
||||
Exit Function
|
||||
End If
|
||||
IsDelim = False
|
||||
End Function
|
||||
|
||||
|
||||
55
src/WordDlg.frm
Normal file
55
src/WordDlg.frm
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} WordDlg
|
||||
Caption = "Óïðàâëåíèå íàäñòðîéêàìè"
|
||||
ClientHeight = 3300
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 4770
|
||||
OleObjectBlob = "WordDlg.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "WordDlg"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private bUpdate_ As Boolean
|
||||
Public isCanceled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCanceled_ = True
|
||||
Call PositionInMiddle(Me)
|
||||
End Sub
|
||||
|
||||
Public Function Init(opts As AddinOptions)
|
||||
isCanceled_ = True
|
||||
CBConcept.Value = opts.data_.Item(T_WA_CONCEPT)
|
||||
CBNpa.Value = opts.data_.Item(T_WA_NPA)
|
||||
CBMarkup.Value = opts.data_.Item(T_WA_MARKUP)
|
||||
CBParsers.Value = opts.data_.Item(T_WA_PARSERS)
|
||||
CBMaket.Value = opts.data_.Item(T_WA_MAKET)
|
||||
End Function
|
||||
|
||||
Public Function GetResult() As AddinOptions
|
||||
Set GetResult = New AddinOptions
|
||||
With GetResult
|
||||
.data_.Item(T_WA_CONCEPT) = CBConcept.Value
|
||||
.data_.Item(T_WA_NPA) = CBNpa.Value
|
||||
.data_.Item(T_WA_MARKUP) = CBMarkup.Value
|
||||
.data_.Item(T_WA_PARSERS) = CBParsers.Value
|
||||
.data_.Item(T_WA_MAKET) = CBMaket.Value
|
||||
End With
|
||||
End Function
|
||||
|
||||
' =======
|
||||
Private Sub BtnCancel_Click()
|
||||
isCanceled_ = True
|
||||
Call Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub BtnOK_Click()
|
||||
isCanceled_ = False
|
||||
Call Me.Hide
|
||||
End Sub
|
||||
BIN
src/WordDlg.frx
Normal file
BIN
src/WordDlg.frx
Normal file
Binary file not shown.
84
src/z_UIMessages.bas
Normal file
84
src/z_UIMessages.bas
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
Attribute VB_Name = "z_UIMessages"
|
||||
' Messaging module
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Enum MsgCode
|
||||
EM_PROJECTS_EMPTY
|
||||
EM_SELECTION_NO_HYPERLINKS
|
||||
EM_SELECTION_EMPTY
|
||||
EM_RELOCATE_DATA_FAIL
|
||||
EM_WORD_IS_OPEN
|
||||
EM_CORE_UPDATE_FAILED
|
||||
EM_WORD_ADDINS_FAILED
|
||||
EM_TEMPLATES_FAILED
|
||||
EM_DIALOG_DATA_INVALID
|
||||
|
||||
IM_LINKS_VALIDATION
|
||||
IM_LINKS_SERVER
|
||||
IM_LINKS_SCAN_OK
|
||||
IM_LINKS_RELOCATE_OK
|
||||
IM_CONCEPT_UPDATE_OK
|
||||
IM_WORD_ADDINS_OK
|
||||
IM_TEMPLATES_OK
|
||||
IM_LINKS_COPY_OK
|
||||
IM_SEARCH_OK
|
||||
End Enum
|
||||
|
||||
Private g_UI As API_UserInteraction
|
||||
|
||||
Public Function UserInteraction() As API_UserInteraction
|
||||
If g_UI Is Nothing Then _
|
||||
Set g_UI = New API_UserInteraction
|
||||
Set UserInteraction = g_UI
|
||||
End Function
|
||||
|
||||
Public Function SetUserInteraction(newUI As API_UserInteraction)
|
||||
Set g_UI = newUI
|
||||
End Function
|
||||
|
||||
Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
|
||||
Dim unwrapped As Variant: unwrapped = params
|
||||
unwrapped = FixForwardedParams(unwrapped)
|
||||
|
||||
Select Case theCode
|
||||
Case EM_PROJECTS_EMPTY: Call MsgBox("Ñïèñîê ïðîåêòîâ ïóñò", vbExclamation)
|
||||
Case EM_SELECTION_NO_HYPERLINKS: Call MsgBox("Â âûäåëåííîì äèàïàçîíå îòñóòñòâóþò ññûëêè", vbExclamation)
|
||||
Case EM_SELECTION_EMPTY: Call MsgBox("Âûäåëåííàÿ îáëàñòü ïóñòà", vbExclamation)
|
||||
Case EM_RELOCATE_DATA_FAIL: Call MsgBox("Óêàæèòå âàëèäíûé êàòàëîã íàçíà÷åíèÿ", vbExclamation)
|
||||
Case EM_WORD_IS_OPEN: Call MsgBox("Çàêðîéòå Word ïåðåä èçìåíåíèåì íàäñòðîåê èëè øàáëîíîâ", vbExclamation)
|
||||
Case EM_CORE_UPDATE_FAILED: Call MsgBox("Íå óäàëîñü óñòàíîâèòü ôàéëû ÊÎÍÖÅÏÒ ñ ñåðâåðà." & vbNewLine _
|
||||
& "Ïðîâåðüòå VPN, ñåòåâûå ïóòè (\\fs1.concept.ru)" & vbNewLine _
|
||||
& "Ïîïðîáóéòå ïåðåçàãðóçèòü Excel äëÿ âûãðóçêè dll", vbExclamation)
|
||||
Case EM_WORD_ADDINS_FAILED: Call MsgBox("Íå óäàëîñü îáíîâèòü íàäñòðîéêè. Ïðîâåðüòå ïîäêëþ÷åíèå ê \\fs1.concept.ru", vbExclamation)
|
||||
Case EM_TEMPLATES_FAILED: Call MsgBox("Íå óäàëîñü îáíîâèòü øàáëîíû", vbExclamation)
|
||||
Case EM_DIALOG_DATA_INVALID: Call MsgBox("Çàïîëíèòå âñå ïîëÿ ôîðìû", vbExclamation)
|
||||
|
||||
Case IM_LINKS_VALIDATION: Call MsgBox(Fmt("Êîëè÷åñòâî íåêîððåêòíûõ ññûëîê íà ôàéëû: {1}/{2}", unwrapped), vbInformation)
|
||||
Case IM_LINKS_SCAN_OK: Call MsgBox(Fmt("Äîáàâëåíî ôàéëîâ: {1}/{2}", unwrapped), vbInformation)
|
||||
Case IM_LINKS_RELOCATE_OK: Call MsgBox(Fmt("Ïåðåìåùåíî ôàéëîâ: {1}/{2}", unwrapped), vbInformation)
|
||||
Case IM_LINKS_SERVER: Call MsgBox(Fmt("Èñïðàâëåíî ãèïåðññûëîê: {1}/{2}", unwrapped), vbInformation)
|
||||
Case IM_CONCEPT_UPDATE_OK: Call MsgBox("Îôèñíûå ïðîäóêòû ÊÎÍÖÅÏÒ îáíîâëåíû óñïåøíî", vbInformation)
|
||||
Case IM_WORD_ADDINS_OK: Call MsgBox("Îáíîâëåíèå íàäñòðîåê çàâåðøåíî", vbInformation)
|
||||
Case IM_TEMPLATES_OK: Call MsgBox("Îáíîâëåíèå øàáëîíîâ çàâåðøåíî", vbInformation)
|
||||
Case IM_LINKS_COPY_OK: Call MsgBox(Fmt("Ñêîïèðîâàíî ôàéëîâ: {1}/{2}", unwrapped), vbInformation)
|
||||
Case IM_SEARCH_OK: Call MsgBox("Ïîèñê çàâåðøåí", vbInformation)
|
||||
|
||||
Case Else: Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
|
||||
Dim unwrapped As Variant: unwrapped = params
|
||||
unwrapped = FixForwardedParams(unwrapped)
|
||||
|
||||
Dim answer&: answer = vbNo
|
||||
Select Case theCode
|
||||
'Case QM_CODE_DELETE_CONFIRM
|
||||
' answer = MsgBox("Are you sure you want to delete ALL macros from target file?", vbYesNo + vbQuestion)
|
||||
|
||||
Case Else
|
||||
Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
|
||||
End Select
|
||||
UIAskQuestion = answer = vbYes
|
||||
End Function
|
||||
42
src/z_UIRibbon.bas
Normal file
42
src/z_UIRibbon.bas
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
Attribute VB_Name = "z_UIRibbon"
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
Public Sub CC_OnRibbonBtn(iControl As IRibbonControl)
|
||||
Select Case iControl.ID
|
||||
Case "CCGroupByRank": Call CC_RunGroupByRank
|
||||
Case "CCGroupByID": Call CC_RunGroupByID
|
||||
|
||||
Case "CCTrimCells": Call CC_RunTrimCells
|
||||
Case "CCTrimPunctuation": Call CC_RunTrimPunctuation
|
||||
Case "CCSubstituteWhitespace": Call CC_RunSubstituteWhitespace
|
||||
Case "CCSplitText": Call CC_RunSplitText
|
||||
Case "CCClearFormatting": Call CC_RunClearFormatting
|
||||
|
||||
Case "CCAnalyseSearch": Call CC_RunAnalyseSearch
|
||||
|
||||
Case "CCLinksCreate": Call CC_RunLinksCreate
|
||||
Case "CCLinksScan": Call CC_RunLinksScan
|
||||
Case "CCLinksValidate": Call CC_RunLinksValidate
|
||||
Case "CCLinksCopyFiles": Call CC_RunLinksCopyFiles
|
||||
Case "CCLinksRelocate": Call CC_RunLinksRelocate
|
||||
Case "CCLinksServer": Call CC_RunLinksServer
|
||||
Case "CCLinksPrint": Call CC_RunLinksPrint
|
||||
|
||||
Case "CCListIncome": Call CC_RunListIncome
|
||||
Case "CCListOutcome": Call CC_RunListOutcome
|
||||
Case "CCListLeads": Call CC_RunListLeads
|
||||
Case "CCListTentative": Call CC_RunListTentative
|
||||
|
||||
Case "CCConceptStatus": Call CC_RunConceptStatus
|
||||
Case "CCUpdateConcept": Call CC_RunUpdateConceptCore
|
||||
Case "CCConfig": Call CC_RunConfig
|
||||
Case "CCWordAddin": Call CC_RunWordAddin
|
||||
Case "CCUpdateTemplates": Call CC_RunUpdateTemplates
|
||||
Case "CCAppdata": Call CC_RunAppdata
|
||||
Case "CCDescriptionUDF": Call CC_RunDescriptionUDF
|
||||
|
||||
Case "CCxlHelp": Call CC_RunHelp
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
2
ui/.rels
Normal file
2
ui/.rels
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
|
||||
<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId4" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/></Relationships>
|
||||
140
ui/customUI.xml
Normal file
140
ui/customUI.xml
Normal file
|
|
@ -0,0 +1,140 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
|
||||
xmlns:CC="Concept Namespace">
|
||||
<ribbon startFromScratch="false" >
|
||||
<tabs>
|
||||
<tab idQ="CC:CustomBtns" label="КОНЦЕПТ" >
|
||||
<group id="Group1" label="Основные функции" >
|
||||
|
||||
<menu id="GroupByMenu" label="Group" imageMso="AddAccount" size="large">
|
||||
<button id="CCGroupByRank" label="по уровню"
|
||||
supertip="Группировать строки по номерам уровней в выделенном диапазоне"
|
||||
imageMso="GroupLevel"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCGroupByID" label="по идентификатору"
|
||||
supertip="Группировать строки по совпадающим идентификаторам в выделенном диапазоне"
|
||||
imageMso="IdentityEdit"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="EditMenu" label="Edit" imageMso="EditDocument" size="large">
|
||||
<button id="CCTrimCells" label="Удалить пробелы и переносы в начале и конце"
|
||||
supertip="Удалить пробелы и переносы строк в начале и конце текста"
|
||||
imageMso="RulesConditionIsBlankGallery"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCTrimPunctuation" label="Удалить знаки в конце"
|
||||
supertip="Удалить знаки препинания в конце текста"
|
||||
imageMso="EndOfDocument"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCSubstituteWhitespace" label="Заменить табуляторы и переносы"
|
||||
supertip="Заменить все специальные знаки пробелами"
|
||||
imageMso="FontsReplaceFonts"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCSplitText" label="Разделить на слова"
|
||||
supertip="Представить текст ячейки как столбец слов под ней"
|
||||
imageMso="SplitVertically"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCClearFormatting" label="Удалить форматирование"
|
||||
supertip="Удалить условное форматирование в заданном диапазоне"
|
||||
imageMso="ConditionalFormattingClearMenu"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="LinksMenu" label="Links" imageMso="DataTypeHyperlink" size="large">
|
||||
<button id="CCLinksCreate" label="Гиперссылки из текста"
|
||||
supertip="Создать гиперссылки из текста ячеек"
|
||||
imageMso="AutoSigWebInsertHyperlink"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksScan" label="Сканировать каталог"
|
||||
supertip="Вставить в выбранную ячейку список всех файлов в каталоге с гиперссылками"
|
||||
imageMso="NewSharedFolderWorkspace"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksValidate" label="Проверить ссылки"
|
||||
supertip="Проверить наличие файлов по ссылкам в выделенных ячейках"
|
||||
imageMso="HyperlinksVerify"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksServer" label="Диски X: и P:"
|
||||
supertip="Исправить сетевые пути на \\strg1 и \\server"
|
||||
imageMso="ServerRestoreSqlDatabase"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksCopyFiles" label="Копировать файлы"
|
||||
supertip="Копировать файлы по ссылкам в выбранных ячейках с обновлением гиперссылок"
|
||||
imageMso="CopyToFolder"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksRelocate" label="Переместить файлы"
|
||||
supertip="Переместить файлы по ссылкам в выбранных ячейках с обновлением гиперссылок"
|
||||
imageMso="GroupMoveActions"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCLinksPrint" label="Печать по ссылкам"
|
||||
supertip="Печать файлов по ссылкам в выделенном диапазоне"
|
||||
imageMso="FileInternetFax"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="AnalyseMenu" label="Анализ" imageMso="RulesManager" size="large">
|
||||
<button id="CCAnalyseSearch" label="Пословный поиск"
|
||||
supertip="Поиск всех вхождений набора словосочетаний в другом наборе словосочетаний"
|
||||
imageMso="GroupSearch"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="ProjectsMenu" label="Проекты" imageMso="AlignJustifyWithMixedLanguages" size="large">
|
||||
<button id="CCListIncome" label="Income проекты"
|
||||
supertip="Вставить список Income проектов"
|
||||
imageMso="DollarSign"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCListOutcome" label="Outcome проекты"
|
||||
supertip="Вставить список Income проектов"
|
||||
imageMso="GroupOutliningTools"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCListLeads" label="Переговоры активные"
|
||||
supertip="Вставить список активных переговоров"
|
||||
imageMso="ConversationGroupMessageOption"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCListTentative" label="Переговоры возможные"
|
||||
supertip="Вставить список возможных переговоров"
|
||||
imageMso="CellAlignmentOptions"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="TechListMenu" label="Технологии" imageMso="AdministrationHome" size="large">
|
||||
<button id="CCConceptStatus" label="Перечень продуктов"
|
||||
supertip="Отображение перечня установленных продуктов и их статусов"
|
||||
imageMso="BlogHomePage"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCUpdateConcept" label="Обновить CONCEPT"
|
||||
supertip="Обновление всех технологий, входящих в состав офисных продуктов КОНЦЕПТ, включая шаблоны документов"
|
||||
imageMso="DesignerRibbonGiveFeedback"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCWordAddin" label="Word Add-Ins"
|
||||
supertip="Управление надстройками Word"
|
||||
imageMso="MindMapExportWord"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCUpdateTemplates" label="Обновить шаблоны"
|
||||
supertip="Обновление шаблонов с сервера"
|
||||
imageMso="QuickStepTemplateMoveToFolder"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCConfig" label="Настройки"
|
||||
supertip="Открыть JSON файл настроек технологий"
|
||||
imageMso="AnimationCustomAddActionVerbDialog"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCAppdata" label="Открыть APPDATA"
|
||||
supertip="Открыть папку %APPDATA%\Microsoft"
|
||||
imageMso="DesignerOpen"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CCDescriptionUDF" label="Описания функций ячеек"
|
||||
supertip="Обновить описания специальных функций в ячейках"
|
||||
imageMso="InsertBuildingBlocksEquationsGallery"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<button id="CCxlHelp" visible="true" size="large"
|
||||
label="Справка"
|
||||
supertip="Вызов справки по надстройкам Excel"
|
||||
imageMso="Info"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</group>
|
||||
</tab>
|
||||
</tabs>
|
||||
</ribbon>
|
||||
</customUI>
|
||||
Loading…
Reference in New Issue
Block a user