Private Sub CommandButton1_Click()
Dim excelobject As Object, wb As Object, r As Long, i As Integer
Dim input_inf
Dim b
input_inf = InputBox("Please edit words and abbreviations are separated by commas and two spaces,Thank you very much for your contribution", "FIND ABBREVIATION", "Abb, A.")
If input_inf = "Abb, A." Or input_inf = "" Then
Exit Sub
End If
b = Left(input_inf, 1)
Set excelobject = CreateObject("excel.application")
excelobject.Visible = False
Set wb = excelobject.Workbooks.Open("Z:\layout\layout deck-old & new\KR\FIND_ABBR\" & b & ".xlsx")
With wb.Worksheets(1)
a = .Cells(.Rows.count, 1).End(-4162).Row
.Cells(a + 1, 1).Value = input_inf
End With
excelobject.ActiveWorkbook.Save
excelobject.Quit
End Sub
Private Sub CommandButton2_Click()
Dim excelobject As Object, wb As Object, r As Long, i As Integer
Dim hh As Boolean
Dim a As String
Dim b
Set excelobject = CreateObject("excel.application") '启动Excel程序
excelobject.Visible = False '不可见
If selection.Range.Characters.count = 1 Then
MsgBox "please select word"
Exit Sub
End If
If selection.Range.Characters.count > 4 Then
a = Left(selection.Range.Text, 4)
Else
a = selection.Range.Text
End If
b = Left(selection.Range.Text, 1)
Set wb = excelobject.Workbooks.Open("Z:\layout\layout deck-old & new\KR\FIND_ABBR\" & b & ".xlsx")
Me.ListBox1.Visible = True
Me.ListBox1.Clear
'.[A65536].End(xlUp).Row
'Cells(Rows.count, 1).End(xlUp).Row
With wb.sheets(1)
For i = 1 To wb.sheets(1).Cells(.Rows.count, 1).End(-4162).Row
'b = wb.sheets(1).Cells(i, 1).Value
If InStr(UCase(Left(wb.sheets(1).Cells(i, 1).Value, 4)), UCase(a)) > 0 Then
Me.ListBox1.AddItem wb.sheets(1).Cells(i, 1).Value
End If
Next i
If Me.ListBox1.ListCount = 0 Then
Me.ListBox1.AddItem "No abbreviation, please add"
End If
End With
excelobject.Quit
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim a As String
Dim b As String
a = ListBox1.Value
arr = Split(a, ",")
selection.Range.Text = Trim(arr(1))
End Sub