Excel VB Script

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"})