Друзья, а возможно макросы КомБокс.xlsm перенести в PERSONAL.xlsb?
В приложенном файле слегка изменил поиск – теперь он ищет и с начала строки и после пробелов (напр. по «Сумки» найдет «г. Тобольск, п. Сумкино, ул. Пушкина, д. 999» и подобные)
Но при переносе кода в личную книгу столкнулся с 2-мя проблемами:
1. Без указания имени файла книги не запускаются ListBox1 и TextBox1 - где его взять?
2. При указании - боксы появляются, но не работают процедуры TextBox1_Change() и ListBox1_Click().
Код в PERSONAL.xlsb в ЭтаКнига (после отключения 3-х процедур в example.xlsm боксы только показывает):
| Код |
|---|
Private WithEvents App As Application
Dim bu As Boolean
Dim Sh As Worksheet
Dim WBN As String
Private Sub Workbook_Open()
Set App = Application
End Sub
Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Sh.Name = "fin" Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C3:C10000")) Is Nothing Then 'serg20200105 "A2:A3000"
If Target.Value <> "" Then: Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = False: Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = False: Exit Sub
bu = True
With Workbooks("example.xlsm").Worksheets("fin").TextBox1
.Top = Target.Top
.Left = Target.Left
.Height = Target.Height
.Width = Target.Width
.Text = Target.Value
.Activate
End With
With Workbooks("example.xlsm").Worksheets("fin").ListBox1
.Top = Target.Top
.Left = Target.Left + Target.Width
.Width = 420
.Clear
End With
bu = False
Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = True
Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = True
Else
Workbooks("example.xlsm").Worksheets("fin").TextBox1.Visible = False
Workbooks("example.xlsm").Worksheets("fin").ListBox1.Visible = False
End If
End Sub
Private Sub TextBox1_Change()
Dim X, i, i_end, txt As String, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub
txt = TextBox1.Text
X = Worksheets("Списки").Columns(1).SpecialCells(2).Value
i_end = Worksheets("Списки").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To i_end
If UCase(txt) = UCase(Mid(Worksheets("Списки").Cells(i, 1), 1, Len(txt))) _
Or InStr(1, UCase(Worksheets("Списки").Cells(i, 1)), UCase(" " & TextBox1.Value)) > 0 _
Then s = s & X(i, 1) & "~" 'Serg20200105
Next i
ListBox1.List = Split(s, "~")
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
bu = True
ActiveCell.Value = ListBox1.Value
Me.TextBox1.Visible = False
Me.ListBox1.Visible = False
bu = False
End Sub
|
