Excel VB Script

客官°小女子只卖身不卖艺 2021-12-17 14:15 243阅读 0赞

## Excel VB 일력 ##

Private Sub Calendar1\_Click()  
Range("A1") = Calendar1.Value  
End Sub  
Private Sub Calendar1\_DblClick()  
Range("A1") = Calendar1.Value  
Calendar1.Visible = False  
Range("A1").Select  
End Sub  
Private Sub Worksheet\_SelectionChange(ByVal Target As Range)  
If Target.Address = "$A$1" Then  
   Calendar1.Value = Now()  
   Calendar1.Visible = True  
Else  
   Calendar1.Visible = False  
End If  
End Sub

---------------------------------------------------------------------------------------------------------------------

## Excel Connect\_DataBase(Sql Server) ##

'引用Microsoft Activex Data Object 2.0 Library  
  Private Sub CommandButton1\_Click()  
    Dim xlsApp As Object  
    Dim Cnn As New ADODB.Connection  
    Dim Rs As ADODB.Recordset

Cnn.ConnectionString = "PROVIDER=SQLOLEDB;SERVER=192.168.0.0;UID=xxx;PWD=xxx;DATABASE=HR\_ST\_STPS"  
    If Cnn.State <> ADODB.ObjectStateEnum.adStateClosed Then Cnn.Close  
    Cnn.Open  
     
    Set Rs = New ADODB.Recordset  
    With Rs  
        Set .ActiveConnection = Cnn  
        .CursorLocation = adUseClient  
        .CursorType = adOpenStatic  
        .LockType = adLockReadOnly  
        .Open "SELECT \* FROM \[HR\_ST\_STPS\].\[dbo\].\[tblPOrgan\] "  
         
    End With  
    If Rs.EOF Then Exit Sub  
    Set xlsApp = CreateObject("Excel.Application")  
   
    'Ans=MsgBox(“Continue?”,vbYesNo)  
     
'    xlsApp.Visible = True  
    xlsApp.Workbooks.Add  
    xlsApp.Sheets("sheet1").Select  
    xlsApp.ActiveSheet.Range("A1").CopyFromRecordset Rs

If xlsApp.ActiveWorkbook.Saved = False Then  
        xlsApp.ActiveWorkbook.SaveAs "C:\\Documents and Settings\\hp\\Desktop\\Test.xlsx"  
        MsgBox ("保存到: C:\\Documents and Settings\\hp\\Desktop\\Test.xlsx")  
    End If  
    xlsApp.Quit  
     
    Rs.Close  
    Set Rs = Nothing  
    Set xlsApp = Nothing  
     
  End Sub

---------------------------------------------------------------------------------------------------------------------

## VB 自动选择Cell 内容 ##

Sub RngFindNext()  
      Dim StrFind As String  
      Dim Rng As Range  
      Dim FindAddress As String  
      StrFind = InputBox("请输入要查找的值:")  
      If Trim(StrFind) <> "" Then  
          With Sheet1.Range("b:b")  
              Set Rng = .Find(What:=StrFind, \_  
                              After:=.Cells(.Cells.Count), \_  
                              LookIn:=xlValues, \_  
                              LookAt:=xlWhole, \_  
                              SearchOrder:=xlByRows, \_  
                              SearchDirection:=xlNext, \_  
                              MatchCase:=False)  
              If Not Rng Is Nothing Then  
                 FindAddress = Rng.Address  
                  Do  
                      Rng.Interior.ColorIndex = 6  
                      Set Rng = .FindNext(Rng)  
                  Loop While Not Rng Is Nothing And Rng.Address <> FindAddress  
              End If  
          End With  
      End If  
End Sub

---------------------------------------------------------------------------------------------------------------------

**Excel Funtion**

=LOOKUP(100-A10,\{0,10,20,30;"A","B","C","D"\})

转载于:https://www.cnblogs.com/kevinkim/archive/2011/12/23/2298913.html