Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Код подрывается при открытом Excel / 18 сообщений из 18, страница 1 из 1
09.04.2009, 13:18
    #35922502
32sasha
32sasha
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Помогите пож.
Когда Excel закрыт перед запуском то выполняется код без проблем, если открыт то подрывается во время копирования листа.
Что не так, помогите пожалуйста.
Проект в студии vb6.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
Sub Main()
Dim iFileName$
Dim CommonFile As Workbook, iFile As Workbook
Dim Sht As Worksheet
Dim objExcel As Object
f = FreeFile

    On Error GoTo ExcelNotOpen
        Set objExcel = GetObject(, "Excel.Application")
    GoTo  2 
    
ExcelNotOpen:
    On Error GoTo ExcelNotPresent
        Set objExcel = CreateObject("Excel.Application")
    GoTo  2 
     
ExcelNotPresent:
MsgBox "Excel не установлен"
Exit Sub
 2 :

objExcel.Workbooks.Add
Set CommonFile = objExcel.ActiveWorkbook

Dim FilePath 
Open "c:\OPEN.TXT" For Binary Access Read As f
Do While Not EOF(f)
    Line Input #f, FilePath 
    FilePath = Split(FilePath, ";")
    If UCase(FilePath( 0 )) Like "*.XLS" And Len(FilePath( 0 )) >  5  Then
        iFileName = Dir(FilePath( 0 ))
        Set iFile = Workbooks.Open(FilePath( 0 ), ReadOnly:=True)
        For Each Sht In iFile.Worksheets
            Sht.Name = Replace(UCase(objExcel.ActiveWindow.Caption), ".XLS", "_") & Sht.Name
            Sht.Copy After:=Workbooks(CommonFile.Name).Sheets(CommonFile.Sheets.Count)
'Если открыт Excel то подрывается в этом месте
                Windows(iFileName).Activate
        Next
        Workbooks(iFileName).Close SaveChanges:=False
    End If
Loop
Close f

Application.DisplayAlerts = False 'Диалог перезаписать или нет не отображается(происходит перезапись)
CommonFile.SaveAs FileName:="C:\" & "All.xls"
objExcel.Quit
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 16:17
    #35923187
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

Код как таковой ужасен, и нет времени его править. Там вы пытаетесь поместить различные задачи в одну процедуру. Разделите их, разведите по разным функциям. Подумайте, что произойдет, если ваш OPEN.TXT будет пуст. Избавьтесь от лишних меток и Exit Sub внутри тела процедуры. Сделайте одну поддержку ошибок. Как-то так:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Public Sub MySub()
    Const METHOD_NAME As String = "MySub"

    On Error GoTo MethodExit
    
.......
.......

MethodExit:
    
    If Err.Number <>  0  Then
        MsgBox "Error " & CStr(Err.Number) & " in " & METHOD_NAME & vbCr & Err.Description
    End If

End Sub

И попробуйте заменить Windows на Workbooks.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 16:20
    #35923200
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

Не забывайте, что сбои в коде для Excel часто оставляют висеть процесс Excel (и не один) невидимо, с непредсказуемыми последствиями.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 16:38
    #35923261
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Еще, мне кажется, что раз вы декларируете

Код: plaintext
1.
Dim CommonFile As Workbook, iFile As Workbook
Dim Sht As Worksheet

то нет причин декларировать

Код: plaintext
Dim objExcel As Object

Все равно вам требутся в проекте библиотека Excel. А раз так, то и пропадает нужда в GetObject и CreateObject.

И тогда можно вводить раннее связывание со всеми его преимуществами:

Код: plaintext
Dim objExcel As New Excel.Application
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 18:36
    #35923591
32sasha
32sasha
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Спасибо, за ответ.
Но подрывается на Sht.Copy After:=Workbooks(CommonFile.Name).Sheets(CommonFile.Sheets.Count)
во время копирования листа с одного файла в исходный.
и выдает ошибку Subscript out of range (Error 9)

OPEN.TXT пустым быть не должен и не будет.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:04
    #35923648
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

Скорее всего, у вас там более чем один процесс Excel. А вы явно не указываете, внутри какого процесса вы копируете листы вашей книги.

Касательно резонирования о файле OPEN.TXТ: на таких рассуждениях поддержка ошибок не строится. Она строится на самой возможности как таковой их возникновения. Точно также, как и оборона. Это, между прочим, первая ошибка, которую я получил, тестируя ваш код.

Успехов.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:08
    #35923658
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Другой возможной причиной может являться то, что код берет полный путь к книге, а надо брать лишь ее имя, чтобы подставить в переменную.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:11
    #35923669
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Уберите хотя бы
Код: plaintext
Go To  2
. Этот стиль заклеймили еще в 70-х.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:19
    #35923682
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

Проверьте, есть ли в вашем objExcel такая книга как Workbooks(CommonFile.Name)
с таким листом как Sheets(CommonFile.Sheets.Count) каждый раз, когда у вас висит неконтролируемый процесс Excel в дополнение к процессу, в котором вы вводите objExcel.

Успехов
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:26
    #35923689
32sasha
32sasha
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Убрал некоторый декларации, оставил
Dim objExcel As New Excel.Application

Выходит что запускается отдельно еще одна копия Excel
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:31
    #35923694
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

То-то и оно.

:0)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:33
    #35923697
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
А, вас напрягает, что запускается еще одна копия Excel из-за New?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 19:55
    #35923716
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Если вам непременно надо использовать имеющийся процесс, и вы не хотите создавать свой, то тогда введите отдельную функцию для этого:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Option Explicit

Dim mobjExcel As Excel.Application

Private Function GetExcel() As Excel.Application

    Const METHOD_NAME As String = "GetExcel"

    On Error GoTo MethodExit
    
    Set GetExcel = GetObject(, "Excel.Application")
    
MethodExit:

    If Err.Number <>  0  Then
        If Err.Number =  429  Then
            Err.Clear
            Set GetExcel = CreateObject("Excel.Application")
            On Error GoTo MethodExit
        Else
            MsgBox "Error " & CStr(Err.Number) & " in " & METHOD_NAME & vbCr & Err.Description
        End If
        
    End If
    
End Function

Private Sub Command1_Click()
    Set mobjExcel = GetExcel
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 20:07
    #35923732
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Может надо сначала активировать книгу, лист, раз процесс уже имелся. Поставьте перед Workbooks mobjExcel. Посмотрите, что получится.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 21:25
    #35923820
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
32sasha,

Как-то так, в дополнение к моему последнему коду:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
Private Sub Command1_Click()
    Dim objCommonWbk As Workbook
    Dim f As Integer
    Dim FilePath() As String
    Dim strFilePath As String
    Dim strFileName As String
    Dim Sht As Worksheet
    Dim objWbk As Workbook

    Const METHOD_NAME As String = "Command1_Click"

    On Error GoTo MethodExit

    Set mobjExcel = GetExcel

    mobjExcel.Workbooks.Add
    Set objCommonWbk = mobjExcel.ActiveWorkbook


    f = FreeFile
    Open "c:\OPEN.TXT" For Binary Access Read As f
    
    Do While Not EOF(f)
        Line Input #f, strFilePath
        FilePath = Split(strFilePath, ";")
        
        If UCase(FilePath( 0 )) Like "*.XLS" And Len(FilePath( 0 )) >  5  Then
            strFileName = Dir(FilePath( 0 ))
            Set objWbk = mobjExcel.Workbooks.Open(FilePath( 0 ), ReadOnly:=True)
            For Each Sht In mobjExcel.Workbooks(objWbk.Name).Worksheets
                Sht.Name = Replace(UCase(mobjExcel.ActiveWindow.Caption), ".XLS", "_") & Sht.Name
                Sht.Copy After:=mobjExcel.Workbooks(objCommonWbk.Name).Sheets(mobjExcel.Workbooks(objCommonWbk.Name).Sheets.Count)
                mobjExcel.Workbooks(strFileName).Activate
            Next Sht
            
            mobjExcel.Workbooks(strFileName).Close SaveChanges:=False
        End If
    Loop

    Close f

    mobjExcel.DisplayAlerts = False
    objCommonWbk.SaveAs FileName:="C:\All.xls"
    mobjExcel.Quit

MethodExit:

    If Err.Number <>  0  Then
            MsgBox "Error " & CStr(Err.Number) & " in " & METHOD_NAME & vbCr & Err.Description
    End If

End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.04.2009, 22:02
    #35923850
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Там в вашем OPEN.TXT нужно, чтобы не было пустой последней строки (не нажимайте ENTER после последней строки с именем файла). Иначе - ошибка. Вот вам, кстати, и пример.

И еще, эти две строки

Код: plaintext
1.
    mobjExcel.Workbooks.Add
    Set objCommonWbk = mobjExcel.ActiveWorkbook

можно заменить одной:

Код: plaintext
    Set objCommonWbk = mobjExcel.Workbooks.Add

и эта строка не нужна:

Код: plaintext
                mobjExcel.Workbooks(strFileName).Activate
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.04.2009, 11:51
    #35924541
32sasha
32sasha
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Спасибо большое!
А как открыть к примеру файл находящийся в сети?
http://projectsrv/sites/MS_ProjectServer_PublicDocuments/Shared%20Documents/02.xls
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.04.2009, 14:18
    #35925051
32sasha
32sasha
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Код подрывается при открытом Excel
Спасибо разобрался.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Код подрывается при открытом Excel / 18 сообщений из 18, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 346ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2161153]:
 0ms
get settings:
 9ms
get forum list:
 19ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 33ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 62ms
get tp. blocked users:
 2ms
others: 200ms
total:  346ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]