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