Excel VBA укрепляет хрупкую функцию - PullRequest
Новая
       8

Excel VBA укрепляет хрупкую функцию

0 голосов
/ 29 августа 2018

Я создал электронную таблицу для отслеживания данных о студентах для моей жены. Есть 2 версии, версия мастера и учителя. Разница лишь в том, что в версии для учителя есть пара скрытых вкладок и кнопок.

В конце каждого дня она собирает версии для учителей и объединяет их данные в основную версию, используя макрос, прикрепленный к кнопке. На регулярной основе это приводит к краху Excel. Похоже, что попытка объединить книгу, которая находится на USB-флешке, - верный способ заставить ее рухнуть, но есть и другие обстоятельства, которые я еще не определил.

Она недостаточно техническая, чтобы шагать по коду, пока он не взорвется, и я не смогу быть там, когда она это делает.

Предыдущие попытки укрепить код включали в себя избавление от любого экземпляра Activesheet или Activeworkbook и всегда с использованием прямой ссылки на рабочий лист (т. Е. Sheet1, но переименованный во что-то значимое - «слияние» в приведенном ниже примере).

Функция ниже, LoadTeacherData, вызывается один раз для каждой объединяемой книги. Все, что он делает, это копирует существующие записи на вкладке данных учителя, копирует их на главную вкладку слияния и затем удаляет их из источника. Я думаю, что после сбоя сразу после выбора файла для загрузки. 

Sub LoadTeacherData()
Dim wb_td As Workbook
Dim td As Worksheet
Dim newdata As Range

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel files", "*.xlsm"

    If .Show = -1 Then
        file_name = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

Application.ScreenUpdating = False
Set wb_td = Workbooks.Open(Filename:=file_name, UpdateLinks:=False, ReadOnly:=False)
If wb_td Is Nothing Then
    MsgBox "Unable to open file, check path", vbOKOnly
    Exit Sub
End If

file_name = wb_td.Name
Set td = wb_td.Worksheets("data")

row = LastRow(td, "C")
col = LastCol(td, 1)
Set newdata = td.Range("a2", td.Cells(row, col))
newdata.Copy Destination:=Merge.Cells(LastRow(Merge, "C") + 1, 1)
newdata.Clear
MsgBox (row - 1 & " records merged")
wb_td.Close
ThisWorkbook.Activate
ThisWorkbook.Save
Application.ScreenUpdating = True


End Sub


Function LastRow(ByRef ws As Worksheet, ByVal colname As String)
    LastRow = ws.Range(colname & ws.Rows.Count).End(xlUp).row
End Function

Function LastCol(ByRef ws As Worksheet, ByVal rownum As Long)
    LastCol = ws.Cells(rownum, ws.Columns.Count).End(xlToLeft).Column
End Function

Я подозреваю, что это как-то связано с разрешениями при открытии файла. Ее версия Excel настроена так, что при открытии файла ей приходится каждый раз включать содержимое.

1 Ответ

0 голосов
/ 29 августа 2018

Возможно, вы имеете дело с поврежденным файлом. Посмотрите на метод workbooks.open. Существует несколько параметров поврежденной загрузки, которые могут помочь. Попробуйте это и поэкспериментируйте, чтобы увидеть, работают ли другие в вашей ситуации лучше. 

Set wb_td = Workbooks.Open(Filename:=file_name, UpdateLinks:=False, ReadOnly:=False, corruptload:=xlRepairFile)
...