Cacher is the code snippet organizer for pro developers

kr_deck


Sub find_abbr_1(ByVal control As IRibbonControl)
Load find_abbr

Dim excelobject As Object, wb As Object, r As Long, i As Integer
Dim hh As Boolean
 
Set excelobject = CreateObject("excel.application") '启动Excel程序
excelobject.Visible = False   '不可见


For i = 2 To 10

Next i
 excelobject.Quit
With find_abbr
            .StartUpPosition = 0
            .Top = Application.Top + 25
            .Left = Application.Left + Application.Width * 0.98 - .Width
            .Show
        End With

End Sub

USER_FORM

Private Sub CommandButton1_Click()
Dim excelobject As Object, wb As Object, r As Long, i As Integer
Dim input_inf

Set excelobject = CreateObject("excel.application")
excelobject.Visible = False
Set wb = excelobject.Workbooks.Open("C:\fuzzy.xlsx")
If wb Is Nothing Then
MsgBox "YOU DO NOT HAVE THE CORRECT PATH TO YOUR WORKBOOK"
Exit Sub
End If
input_inf = InputBox("测试输入", "输入框标题", "输入一些内容")
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 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
Private Sub UserForm_Activate()
Dim excelobject As Object, wb As Object, r As Long, i As Integer
Dim hh As Boolean
Dim a As String
Dim b As Integer
Set excelobject = CreateObject("excel.application") '启动Excel程序
excelobject.Visible = False   '不可见

If selection.Range.Characters.count > 3 Then
a = Left(selection.Range.Text, "3")
Else
a = selection.Range.Text
End If
b = 106
Set wb = excelobject.Workbooks.Open("C:\fuzzy.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 = 2 To wb.sheets(1).Cells(.Rows.count, 1).End(-4162).Row
    If InStr(UCase(wb.sheets(1).Cells(i, 1).Value), UCase(a)) > 0 Then
    Me.ListBox1.AddItem wb.sheets(1).Cells(i, 1).Value
    End If
Next i
    End With

excelobject.Quit
End Sub