标签：pat smm save pes form ica after shel paste
Public Function GetClipboardText() Dim a As New DataObject a.GetFromClipboard GetClipboardText = a.GetText
End Function
Sub CopyStr(ByVal str As String) Dim STRAA As String Dim MyData As DataObject STRAA = str Set MyData = New DataObject MyData.SetText STRAA MyData.PutInClipboard Set MyData = Nothing End Sub
‘找ie
Function FindIEWinByName(ByVal strRef As String) As Object Dim objWin As Object Dim i As Integer i = 1 For Each objWin In CreateObject("Shell.Application").Windows Do While objWin.ReadyState <> 4 Or objWin.Busy DoEvents Sleep2 500 i = i + 1
If i > 5 And InStr(objWin.LocationName, "https://globe7aoa.nestle.com:26001/irj/servlet/prt") <> Empty Then
objWin.Quit GoTo end_ie End If Loop If LCase(TypeName(objWin.Document)) = "htmldocument" Then If objWin.LocationName Like "*" & strRef & "*" Then Set FindIEWinByName = objWin Exit For End If End If end_ie: Next Set objWin = Nothing End Function
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Const SC_MINIMIZE As Long = &HF020& Const SC_MAXMIZE As Long = &HF030& Const SC_CLOSE = &HF060& Const WM_SYSCOMMAND = &H112
Sub SetTop10NWindow() ‘Dim objwindow As MSHTML.HTMLWindow2 Set objwindow = FindWinByName("Balance Display") If objwindow.hwnd <> 0 Then SendMessage objwindow.hwnd, WM_SYSCOMMAND, SC_MAXMIZE, ByVal 0& SetForegroundWindow objwindow.hwnd End If
End Sub
Sub SetBottom10NWindow() ‘Dim objwindow As MSHTML.HTMLWindow2 Set objwindow = FindWinByName("Balance Display") If objwindow.hwnd <> 0 Then SendMessage objwindow.hwnd, WM_SYSCOMMAND, SC_MINIMIZE, ByVal 0& ‘ SetForegroundWindow objwindow.hwnd End If End Sub
Sub IeClose() For Each Process In GetObject("winmgmts:").ExecQuery("select * from Win32_Process where name=‘iexplore.exe‘") Process.Terminate (0) Next End Sub
‘设置value ,函数
Sub setNrtValue(ByVal filepath As String, ByVal index As Integer)
Application.DisplayAlerts = False
‘ShNRT.Range("F9").Formula = "=‘C:\Users\nbluoli\Desktop\work NRT\NRT10.11\account\[CN14_2084000_IG Payable_201709.xlsb]Reconciliation‘!$O$7"
ShNRT.Range("F" & index).Formula = "=‘" & filepath & "Reconciliation‘!$O$7" ShNRT.Calculate ShNRT.Range("F" & index).Copy ShNRT.Range("F" & index).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ‘ShNRT.Range("F9").Paste
End Sub
Function FunArray(ByVal str As String)
FunArray = Split(str, "_")
End Function
strPriod = Format(priod, "yyyymm")
Public Function GetImageFolder() As String GetImageFolder = Application.Workbooks("fbl.xlsm").Path & "\temp\image\" End Function
Sub DelFile(ByVal filepath As String) If Dir(filepath) <> "" Then Kill filepath End If End Sub
Sub InsertImage(ByVal SH As Worksheet, ByVal picpath As String) ‘del image Dim Shp As Shape For Each Shp In SH.Shapes ‘ If Shp.Type = msoPicture Then Shp.Delete ‘ End If Next SH.Shapes.AddPicture picpath, True, True, 10, 10, 600, 380 Workbooks(xlsmMain).Save ‘sh.Pictures.Insert (picpath) ‘????
End Sub
‘sap danamic Set Connection = Application1.Children(CLng(i))
ActiveWorkbook.Save Call Shell(Application.ActiveWorkbook.Path & "\open.bat") Application.Quit
Sub test_oledb()
Dim objconn As ADODB.Connection Dim objrs As ADODB.Recordset Set objconn = New ADODB.Connection objconn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties=‘excel 12.0;hdr=no‘;data source=C:\Users\nbluoli\Desktop\work NRT\NRT10.11\account\CN14_2057070_Accrual 1_201709.xlsb" objconn.Open
End Sub
Function GetRegularNum(values As String) As Integer Dim mRegExp As RegExp Dim mMatches As MatchCollection ‘????????? Dim mMatch As Match ‘?????
Set mRegExp = New RegExp With mRegExp .Global = True ‘True??????, False??????????? .IgnoreCase = True ‘True????????, False??????? .Pattern = "([0-9])?([0-9])+|([0-9])+" ‘?????? Set mMatches = .Execute(values) ‘??????,???????????,????,??? GetRegularNum = mMatches(0).Value End With Set mRegExp = Nothing Set mMatches = Nothing End Function
Sub test() dd = GetRegularNum("Additional Documentation ( 1 )|Additional Documentation ( 3 )")
End Sub
targetfile = folderT & strCompany & "_" & strAccount & "_" & strDetail & "_" & strPriod & ".xlsb"
If Dir(targetfile) = "" Then Sheet1.Range("O" & i) = "error:" & targetfile & " not exits!" GoTo query_error End If
‘ Application.GetObject(targetfile) ‘ Workbooks.Open(targetfile) Application.DisplayAlerts = False Set Wb2 = Workbooks.Open(targetfile, False) Set wb = GetObject(strFile) Set SH = wb.Sheets(1) rowLast = SH.Range("A60000").End(xlUp).Row + 5 SH.Range("A2", "Q" & rowLast).Copy SH.Range("A2", "Q" & rowLast).Copy sh2.Range("E10")
Dim shimage As Worksheet ‘insert into image For Each shitem In Wb2.Sheets If shitem.Name = "Additional Requirements" Then Set shimage = shitem Exit For End If Next
Sub callWindowTh()
Set AppAttach = New Application AppAttach.Visible = True
Dim objWB As Workbook Set objWB = AppAttach.Workbooks.Open(GetCurrentPath & "\window.xlsm", False, True) ‘objApp.Run "window.xlsm!Test_Attach" AppAttach.Left = 1 AppAttach.Top = 1 AppAttach.Width = 800 AppAttach.Height = 600 End Sub
Private Sub Workbook_Open() updateExcel Sleep (2000) ReNameFile End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) If Application.ActiveSheet.codeName = "ShNRT" Then Call Shell(Application.Workbooks(xlsmMain).Path & "\close.bat") End If End Sub
years = Left(Sheet1.Range("H2").Value, 4) months = Right(Sheet1.Range("H2").Value, 2) priod = DateSerial(years, months, 1) priodEnd = DateSerial(years, months + 1, 0)
Function FindWnd(ByVal wName As String) As Long If Val(Application.Version) < 9 Then FindWnd = FindWindow("ThunderXFrame", wName) ‘XL97 Else FindWnd = FindWindow("ThunderDFrame", wName) ‘XL2000 End If If FindWnd = 0 Then FindWnd = FindWindow(vbNullString, wName) End Function
标签：pat smm save pes form ica after shel paste
原文地址：http://www.cnblogs.com/cancelbug/p/7662468.html
