VB6 封裝VBA問題

pc2006

以下是在每一欄上加列的名稱, 在運行第一個EXCEL檔時正常,但運行第二個EXCEL檔就不見了EXCEL,請問是什麼問題? 謝謝

1. Private Sub Command1_Click()
   
2. 
   
3. 
   
4.     Dim ex As Excel.Application
   
5.     Set ex = CreateObject("Excel.Application")
   
6.     ex.Visible = True
   
7.     FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
   
8.     Set WB = Application.Workbooks.Open(FileName)
   
9.     Dim i As Long
   
10. 
    
11.     Range("A1").Select
    
12. 
    
13.     For i = 2 To 10
    
14. 
    
15. 
    
16. 
    
17. 
    
18.     ActiveCell.Rows("1:1").EntireRow.Select
    
19.     Selection.Copy
    
20.     ActiveCell.Offset(2, 0).Rows("1:1").EntireRow.Select
    
21.     Selection.Insert Shift:=xlDown
    
22.     ActiveCell.Cells.Select
    
23.     ActiveCell.Activate
    
24. 
    
25. 
    
26.     Next
    
27. 
    
28. 
    
29. 
    
30.     MsgBox "Done."
    
31. 
    
32. 
    
33. 
    
34. 
    
35. 
    
36. End Sub

复制代码

zhaogang1960

加一个判断，Excel是否已经打开了

1. Private Sub Command1_Click()
   
2. 
   
3. 
   
4.     Dim ex As Excel.Application
   
5.     On Error Resume Next
   
6.     Set ex = GetObject(, "Excel.Application")
   
7.     On Error GoTo 0
   
8.     If ex Is Nothing Then Set ex = CreateObject("Excel.Application")
   
9.     ex.Visible = True
   
10.     FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
    
11.     Set WB = Application.Workbooks.Open(FileName)
    
12.     Dim i As Long
    
13. 
    
14.     Range("A1").Select
    
15. 
    
16.     For i = 2 To 10
    
17. 
    
18. 
    
19. 
    
20. 
    
21.     ActiveCell.Rows("1:1").EntireRow.Select
    
22.     Selection.Copy
    
23.     ActiveCell.Offset(2, 0).Rows("1:1").EntireRow.Select
    
24.     Selection.Insert Shift:=xlDown
    
25.     ActiveCell.Cells.Select
    
26.     ActiveCell.Activate
    
27. 
    
28. 
    
29.     Next
    
30. 
    
31. 
    
32. 
    
33.     MsgBox "Done."
    
34. 
    
35. 
    
36. 
    
37. 
    
38. 
    
39. End Sub
    

复制代码

zhaogang1960

在VB6中不要再出现Application，换成ex，且把所有单元格、工作表等前面都加上ex.

1. Private Sub Command1_Click()
   
2.     Dim ex As Excel.Application
   
3.     On Error Resume Next
   
4.     Set ex = GetObject(, "Excel.Application")
   
5.     On Error GoTo 0
   
6.     If ex Is Nothing Then Set ex = CreateObject("Excel.Application")
   
7.     ex.Visible = True
   
8.     FileName = ex.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
   
9.     Set WB = ex.Workbooks.Open(FileName)
   
10.     Dim i As Long
    
11.     ex.Range("A1").Select
    
12.     For i = 2 To 10
    
13.     ex.ActiveCell.Rows("1:1").EntireRow.Select
    
14.     ex.Selection.Copy
    
15.     ex.ActiveCell.Offset(2, 0).Rows("1:1").EntireRow.Select
    
16.     ex.Selection.Insert Shift:=xlDown
    
17.     ex.ActiveCell.Cells.Select
    
18.     ex.ActiveCell.Activate
    
19.     Next
    
20. 
    
21.     MsgBox "Done."
    
22. End Sub
    

复制代码