ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Код подрывается при открытом Excel
18 сообщений из 18, страница 1 из 1
Код подрывается при открытом Excel
    #35922502
32sasha
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
32sasha
Участник
Помогите пож.
Когда 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, 13:18
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923187
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
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:17
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923200
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
32sasha,

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

Код: 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, 16:38
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923591
32sasha
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
32sasha
Участник
Спасибо, за ответ.
Но подрывается на Sht.Copy After:=Workbooks(CommonFile.Name).Sheets(CommonFile.Sheets.Count)
во время копирования листа с одного файла в исходный.
и выдает ошибку Subscript out of range (Error 9)

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

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

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

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

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

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

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

То-то и оно.

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

Код: 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, 19:55
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923732
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
Может надо сначала активировать книгу, лист, раз процесс уже имелся. Поставьте перед Workbooks mobjExcel. Посмотрите, что получится.
...
Рейтинг: 0 / 0
09.04.2009, 20:07
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923820
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
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, 21:25
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35923850
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
Там в вашем 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
09.04.2009, 22:02
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35924541
32sasha
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
32sasha
Участник
Спасибо большое!
А как открыть к примеру файл находящийся в сети?
http://projectsrv/sites/MS_ProjectServer_PublicDocuments/Shared%20Documents/02.xls
...
Рейтинг: 0 / 0
10.04.2009, 11:51
| Ответить | Цитировать | Написать  
Код подрывается при открытом Excel
    #35925051
32sasha
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
32sasha
Участник
Спасибо разобрался.
...
Рейтинг: 0 / 0
10.04.2009, 14:18
| Ответить | Цитировать | Написать  
18 сообщений из 18, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Код подрывается при открытом Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=35923682&tid=2161153]:
 0ms
get settings:
 6ms
get forum list:
 10ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 47ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 50ms
get tp. blocked users:
 1ms
others: 202ms
total:  333ms
созд. / загр.: 333ms
x
x
Закрыть


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