Считываем файл и сохраняем поля файла в массив, который в последствии будем обрабатывать. Если обработка не нужна, можно сразу заполнять информацию в ячейки экселя...
Запускаем эксель, нажимаем Alt+F11, вставляем в соответствующие Sub():
Open(File_wrk) For Input As #1
Do Until EOF(1)
Line Input #1, Value
FileText = FileText & Value ‘здесь можно сразу сохранять в двумерный массив добавив счетчик прочитанных строк
Loop
Close #1
Для удобства обработки создаем меню и назначаем горячие клавиши...
СОЗДАНИЕ МЕНЮ:
Option Explicit 'Обязательное объявление переменных
Option Compare Text 'Обработка текстовых значений без учёта регистра
Sub s_ГРМеню()
Call f_ГРМеню(CBCReset:=False)
End Sub
Function f_ГРМеню(Optional ByVal CBCReset As Boolean)
Dim i As Byte
Dim CBC As Variant
Dim Msg As Variant
'Удалить главное меню
If CBCReset = True Then
If CommandBars(1).Controls.Count > 0 Then CommandBars(1).Reset
If CommandBars("Cell").Controls.Count > 0 Then CommandBars("Cell").Reset
Exit Function
End If
'Создать главное меню
For i = 1 To 2 Step 1: DoEvents
Select Case i
Case 1: Msg = 1
Case 2: Msg = "Cell"
End Select
'CommandBars(Msg).Reset
CBC = False
For Each CBC In CommandBars(Msg).Controls: DoEvents
If InStr(CBC.Caption, "ГрафикРабот") > 0 Then
CBC = True
Exit For
End If
Next CBC
If CBC = False Then
With CommandBars(Msg).Controls.Add(Type:=msoControlPopup, Temporary:=True)
.Caption = "ГрафикРабот"
.Visible = True
With .Controls
'Директории и файлы
With .Add(Type:=msoControlPopup, Temporary:=True)
.Caption = "Директории и файлы"
With .Controls
With .Add(Type:=msoControlButton): .FaceId = 303: .BeginGroup = False: .Caption = "Текущая структура директорий": .OnAction = "s_ГРСтруктураДиректорийСкан": End With
With .Add(Type:=msoControlButton): .FaceId = 464: .BeginGroup = False: .Caption = "Удалить структуру директорий": .OnAction = "s_ГРСтруктураДиректорийУдалить": End With
With .Add(Type:=msoControlButton): .FaceId = 462: .BeginGroup = False: .Caption = "Создать структуру директорий": .OnAction = "s_ГРСтруктураДиректорийСоздать": End With
With .Add(Type:=msoControlButton): .FaceId = 313: .BeginGroup = False: .Caption = "Менеджер файлов": .OnAction = "s_ГРМенеджерФайлов": End With
With .Add(Type:=msoControlButton): .FaceId = 790: .BeginGroup = False: .Caption = "Менеджер гиперссылок": .OnAction = "s_ГРМенеджерГиперссылок": End With
End With
End With
End With
End With
End If
Next i
End Function
Sub s_ГРГорячиеКлавиши()
Call f_ГРГорячиеКлавиши(CBCReset:=False)
End Sub
Function f_ГРГорячиеКлавиши(Optional ByVal CBCReset As Boolean)
Dim i As Double
Dim CBC As Variant
Dim Msg As Variant
CBC = ""
Call f_Администрирование
For Each CBC In CommandBars("Cell").Controls("ГрафикРабот").Controls: DoEvents
If InStr(CBC.Caption, "горячие клавиши") > 0 Then
CBC = CBC.Caption
Exit For
End If
Next CBC
If CBC = "" Then Exit Function
If InStr(CBC, "Отключить горячие клавиши") > 0 Then
For i = 1 To 2 Step 1: DoEvents
If i = 1 Then Msg = 1 Else _
If i = 2 Then Msg = "Cell"
If InStr(CBC, "Отключить горячие клавиши") = 0 Then Exit For
With CommandBars(Msg).Controls("ГрафикРабот").Controls("Отключить горячие клавиши")
.FaceId = 1087
.Caption = "Включить горячие клавиши"
.OnAction = "s_ГРГорячиеКлавиши"
End With
Next i
'Создать
Application.OnKey Key:="^%{l}", Procedure:="" 'Лист: Ctrl+Alt +l"
Application.OnKey Key:="^%{t}", Procedure:="" 'Шаблон: Ctrl+Alt +t"
Application.OnKey Key:="^%{y}", Procedure:="" 'Копия: Ctrl+Alt +y"
Application.OnKey Key:="^%{p}", Procedure:="" 'Параметры: Ctrl+Alt +p"
Application.OnKey Key:="^%{d}", Procedure:="" 'Диаграмма: Ctrl+Alt +d"
Application.OnKey Key:="^%{s}", Procedure:="" 'Горизонт: Ctrl+Alt +s"
Else
If InStr(CBC, "Включить горячие клавиши") > 0 Then
For i = 1 To 2 Step 1: DoEvents
If i = 1 Then Msg = 1 Else _
If i = 2 Then Msg = "Cell"
If InStr(CBC, "Включить горячие клавиши") = 0 Then Exit For
With CommandBars(Msg).Controls("ГрафикРабот").Controls("Включить горячие клавиши")
.FaceId = 1088
.Caption = "Отключить горячие клавиши"
.OnAction = "s_ГРГорячиеКлавиши"
End With
Next i
'Создать
Application.OnKey Key:="^%{l}", Procedure:="s_ГРЛист" 'Лист: Ctrl+Alt +l"
Application.OnKey Key:="^%{t}", Procedure:="s_ГРШаблон" 'Шаблон: Ctrl+Alt +t"
Application.OnKey Key:="^%{y}", Procedure:="s_ГРКопия" 'Копия: Ctrl+Alt +y"
Application.OnKey Key:="^%{p}", Procedure:="s_ГРСоздатьПараметры" 'Параметры: Ctrl+Alt +p"
Application.OnKey Key:="^%{d}", Procedure:="s_ГРСоздатьДиаграмма" 'Диаграмма: Ctrl+Alt +d"
Application.OnKey Key:="^%{s}", Procedure:="s_ГРСоздатьСводка" 'Горизонт: Ctrl+Alt +s"
End If
End If
End Function
Function f_CreateMenuFaceID() 'Создание меню ЗНАЧКИ с образцами кнопок панели инструментов
Dim CBC As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim MenuItem1 As CommandBarControl
Dim MenuItem2 As CommandBarControl
Dim SubMenuItem As CommandBarButton
Dim MaxCount As Long
Dim MaxGroup As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
For Each CBC In CommandBars(1).Controls: DoEvents
If CBC.Caption = "Значки" Then CBC.Delete
Next CBC
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, Temporary:=True)
NewMenu.Caption = "Значки"
MaxCount = 40
MaxGroup = 8
n = MaxGroup * MaxCount
For j = 0 To 20 Step 1: DoEvents
Set MenuItem1 = NewMenu.Controls.Add(Type:=msoControlPopup)
With MenuItem1
.Caption = j * n + 1 & " - " & (j + 1) * n
.BeginGroup = True
End With
For i = 0 To MaxGroup - 1 Step 1: DoEvents
Set MenuItem2 = MenuItem1.Controls.Add(Type:=msoControlPopup)
MenuItem2.Caption = 1 + j * n + MaxCount * i & " - " & j * n + MaxCount * (i + 1)
For k = j * n + 1 + MaxCount * i To j * n + MaxCount * (i + 1) Step 1: DoEvents
Set SubMenuItem = MenuItem2.Controls.Add(Type:=msoControlButton)
With SubMenuItem
.Caption = "FaceId = " & k
.FaceId = k
End With
DoEvents
Next k
DoEvents
Next i
Next j
Set NewMenu = Nothing
Set MenuItem1 = Nothing
Set MenuItem2 = Nothing
Set SubMenuItem = Nothing
End Function
