2015-04-21 3 views
0

Я пытался выяснить эту подпрограмму в течение нескольких дней. Я прочитал каждое сообщение о VBA copy-paste на этом сайте и еще не нашел ответа. Концепция настолько проста, но когда я запускаю ее с помощью командной кнопки, она останавливается после открытия книги копирования, копия не выполняется. Когда я перехожу к отладке, он работает так, как ожидалось. Кто-нибудь видит очевидные ошибки?Разочарование с копией VBA от книги к рабочей книге

'Must have reference to "Microsoft Scripting Runtime" checked 
Dim fso As New FileSystemObject 
Dim wsData as Worksheet 
Dim stPDFName As String 
Dim stFileName As String 
Dim stReport As String 
Dim WSCopy As Worksheet 
Dim FD As Office.FileDialog 
Set wsData = ThisWorkbook.Sheets("Sheet1") 
Set FD = Application.FileDialog(msoFileDialogFilePicker) 
     FD.InitialFileName = "J:\Laboratory\Reports\2015" 
     FD.Show 
     stReport = FD.SelectedItems(1) 
     stFileName = fso.GetFileName(stReport) 
     stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf" 
    If Dir(stPDFName) = "" Then 
     MsgBox "Matching PDF version of this report does not exist": 
     Exit Sub 
    Else 
     Workbooks.Open (stReport) 
     For Each WSCopy In Workbooks(stFileName).Worksheets 
     If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then 
      WSCopy.Range("A1", "BZ5000").Copy 
      wsData.Range("E2").PasteSpecial 
      wsData.Columns.AutoFit 
      Workbooks(stFileName).Close 
      Exit For 

     End If 
    Next WSCopy 
    End If 

Edit: Я считаю, что я сузил проблему до линии: If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then Когда я пошагово рутины, то StrComp оценивает должным образом. Если я прокомментирую строки If/End If, процедура работает так, как ожидалось. Я использую эту строку, чтобы избежать проблем, возникающих, когда кто-то перемещает или переименовывает рабочий лист.

+1

До сих пор он дошел до диалоги? Если он работает слишком быстро и что-то пропускает, вам может потребоваться добавить строку 'Do Events', чтобы замедлить ее, чтобы завершить одну операцию перед тем, как начать следующую. – CactusCake

+1

Как насчет использования 'WSCopy.Range (« A1: BZ5000 »)'? – BruceWayne

+0

@JoeMalpass, имеет смысл, что что-то может быть пропущено. Это объясняет, почему это будет работать при переходе, но не с помощью командной кнопки. Я добираюсь до filedialog, и выбранная книга открывается, но ничего не копируется. Где я должен добавить «Do events»? Отправьте ответ с вашим предложением, чтобы я мог выбрать его в качестве ответа. –

ответ

0

Если мое подозрение правильное и макрос опережает себя, это должно замедлить его достаточно, чтобы выполнить его правильно. Мое лучшее предположение заключается в том, что не задано время для значения в stReport, поэтому я поставил там цикл, но вам, возможно, придется попробовать его перемещать. Вы можете проверить, где макрос убегает от себя, установив кучу контрольных точек и посмотрев, какие из них позволяют вам успешно возобновить остальную часть скрипта после остановки, а какие из них не будут разбиты.

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

'Must have reference to "Microsoft Scripting Runtime" checked 
Dim fso As New FileSystemObject 
Dim wsData as Worksheet 
Dim stPDFName As String 
Dim stFileName As String 
Dim stReport As String 
Dim WSCopy As Worksheet 
Dim FD As Office.FileDialog 
Set wsData = ThisWorkbook.Sheets("Sheet1") 
Set FD = Application.FileDialog(msoFileDialogFilePicker) 
    FD.InitialFileName = "J:\Laboratory\Reports\2015" 
    FD.Show 

     Do Until Not(IsEmpty(stReport)) 
      stReport = FD.SelectedItems(1) 
      DoEvents 
     Loop 

    stFileName = fso.GetFileName(stReport) 
    stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf" 
If Dir(stPDFName) = "" Then 
    MsgBox "Matching PDF version of this report does not exist": 
    Exit Sub 
Else 
    Workbooks.Open (stReport) 
    For Each WSCopy In Workbooks(stFileName).Worksheets 
    If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then 
     WSCopy.Range("A1", "BZ5000").Copy 
     wsData.Range("E2").PasteSpecial 
     wsData.Columns.AutoFit 
     Workbooks(stFileName).Close 
     Exit For 

    End If 
Next WSCopy 
End If 
+0

Я попытался переместить цикл «DoEvents» в разные места, и он по-прежнему делает то же самое. Он открывает файл, который нужно скопировать, а затем просто выходит из подпрограммы. Я думаю, что я выделил проблему для строки 'If StrComp (WSCopy.CodeName,« Sheet1 », vbTextCompare) = 0 Then'. Если я прокомментирую эту строку (и «end if»), все будет хорошо. –

Смежные вопросы