楼主
kevinchengcw |
- 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 Const HWND_TOPMOST& = -1 ' 将窗口置于列表顶部，并位于任何最顶部窗口的前面
- Private Const SWP_NOSIZE& = &H1 ' 保持窗口大小
- Private Const SWP_NOMOVE& = &H2 ' 保持窗口位置
- Private Sub Form_Load()
- SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE ' 将窗口设为总在最前
- End Sub
- Private Sub Command1_Click()
- Dim xlApp As Object, FN$, WB, WS, Rng, N, I&
- Set xlApp = CreateObject("excel.application")
- With xlApp
- .Visible = True
- MsgBox "请在后面弹出的对话框里选择要打开的Excel文件", , "提示"
- AppActivate .Caption
- FN = .GetOpenFilename("Excel 文件,*.xls?;*.xls", , , , False)
- If CStr(FN) <> "False" Then
- Set WB = .Workbooks.Open(FN)
- AppActivate Me.Caption
- MsgBox "请选择工作表后按确定按钮" & vbNewLine & vbNewLine & "选好后点确定按钮", , "提示"
- AppActivate .Caption
- Set WS = WB.ActiveSheet
- AppActivate Me.Caption
- Retry:
- N = InputBox("请输入要复制的数量:", "输入")
- If N = "" Then GoTo Skip
- For I = 1 To N
- WS.Copy after:=WB.ActiveSheet
- Next I
- 'WB.Save
- .ScreenUpdating = True
- AppActivate Me.Caption
- MsgBox "处理完成了，自己保存结果吧", , "提示"
- Else
- Skip:
- AppActivate Me.Caption
- MsgBox "您取消了输入，程序退出！", , "提示"
- End If
- End With
- Set xlApp = Nothing
- End Sub
- Private Sub Command2_Click()
- Unload Me
- End Sub
与VBA中创建excel.application对象调用操作excel区别不大。
 工资条生成程序.rar
|
测试结果 ...没反应 ..死了