сохранить и закрыть файл в бэкграунде

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » сохранить и закрыть файл в бэкграунде (Макросы/Sub)

Tunka-s

Дата: Четверг, 11.01.2018, 18:19 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 124

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Здравствуйте. Опять я тут. У меня есть простенький код собранный с миру по нитке и он вроде даже почти работает, но иногда файл, который открывается "незаметно глазу", почему-то не закрываетыса как должен, а остается висеть в бакграунд процессах. В принципе Ексел даже выдает диалоговое окно - "вы точно хотите сохранить файл?" , но это диалоговое окно тоже невидимое глазу и проявляется только когда выключаешь комп! Эта проблема не возникает вроде бы когда я запускаю Макрос вручную из окна разработчика, но как только я привязываю макрос к кнопке на панеле быстрого доступа, ни одно окно не закрывается. Подскажите пожалуйста, как можно принудительно сохранить и закрыть файл в бэкграунде?

[vba]

Код

Sub Transfer_Data()

    Dim BookFrom, BookTo As Worksheet

    'Set BookFrom = ThisWorkbook.Worksheets("Sharepoint")
    Application.ScreenUpdating = False


    'Sub OpenAndManipulate()
    Dim xl0 As New Excel.Application
    Dim xlwb As New Excel.Workbook
    Dim ws As Worksheet
    Dim b As Integer


    Set xlwb = xl0.Workbooks.Open("https://terumoemea.sharepoint.com/sites/teamrooms/masterdatacreation/Info%20files/RA_additional_Data_consolidation.xlsx")


    Set ws = xlwb.Worksheets("Overview NHS materials")


Dim PkgPc, PkgBox, PkgCar, CatCode, GTIN, BrName, FunN, Descr, LgMFG, MedDevCl, SpPart, NHS, GMDN, UNSPSC, LabLtx, NoLtx, Batch, PkgDate, SerNLoc, DEHP, Reuse, MRI, StrlMnf, StrlCus, ImplM, ClSzT1, ClSzV1, ClSzUom1, ClSzT2, ClSzV2, ClSzUom2, ClSzT3, ClSzV3, ClSzUom3 As Range

Dim shvid As Worksheet
WSh = Array("QS-702C HAWA OCP-Trading Goods", "QS-702G FERT-Fin. Goods Belgium", "QS-702E ROH - Raw Materials", "QS-702F HALB - Semi fin. goods", "QS-702G FERT - Fin. Goods UK")
On Error Resume Next
For i = 0 To UBound(WSh)
    If Sheets(WSh(i)).Visible = -1 Then
        Set shvid = Sheets(WSh(i))
        Exit For
    End If
Next i
On Error GoTo 0
With shvid

On Error Resume Next

    b = ws.Cells(Rows.Count, 1).End(xlUp).Row

   xl0.Worksheets(1).Cells(b + 1, 1) = .Cells(6, 10)

Set CatCode = .Range("A1:IV65536").Find("Product code, item reference for customer (code on label = Z1)", , xlValues)
Set GTIN = .Range("A1:IV65536").Find("GS1-EAN Code (= EAN code with 0) only last 13 char to enter", , xlValues)

xl0.Worksheets(1).Cells(b + 1, 2) = .Cells(CatCode.Row, CatCode.Column + 1)
xl0.Worksheets(1).Cells(b + 1, 3) = .Cells(GTIN.Row, GTIN.Column + 1)


End With

    xlwb.Save
    xlwb.Close
    Set xl0 = Nothing
    Set xlwb = Nothing
End Sub

[/vba]

Код