Сохранить буфер обмена при закрытии книги VBA - PullRequest
0 голосов
/ 08 января 2020

Кажется, это простой вопрос, но я не могу найти правильный ответ в Google.

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

Мне известна функция отключения приглашения буфера обмена:

Application.CutCopyMode = False
ActiveWindow.Close

Но это не сохраняет буфер обмена. До сих пор я написал для этого следующий код:

Sub Input()

Application.ScreenUpdating = False

Dim wb As Workbook
Dim wbPad As String

On Error GoTo ErrHandler

wbPad = ThisWorkbook.Sheets("Voorblad").Range("C10").Value
    Set wb = Workbooks.Open(wbPad)

    Cells.Select
    Selection.Copy
    Windows("Masterfile.xlsm").Activate
    Worksheets("INPUT").Activate
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
    Worksheets("Voorblad").Activate

Exit Sub

ErrHandler:
    MsgBox ("Bestand niet gevonden. Controleer de maand en de naam van het bestand dat je wilt openen")

End Sub

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

Ответы [ 2 ]

0 голосов
/ 08 января 2020

Поскольку вы не указали способ сохранения диапазона, я добавил несколько базовых c примеров ниже.

OPT1 - Сохранить как .xlsx или .csv

Dim cpyRng As Range, newWb As Workbook, sPath As String

Application.DisplayAlerts = False 'remove system alert prompts

Set cpyRng = ThisWorkbook.Sheets("Sheet1").Range("A1:C10") 'Change sheet and range as needed

sPath = ThisWorkbook.Path & "\"

    Set newWb = Workbooks.Add

    With newWb
        cpyRng.Copy
        .Sheets("Sheet1").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        .SaveAs Filename:=sPath & "Test" & "_" & Format(Date, "yyyymmdd") & ".xlsx", FileFormat:=51 'change file name to suit

        'If you want to save as .csv use
        '.SaveAs Filename:=sPath & "Test" & "_" & Format(Date, "yyyymmdd") & ".csv", FileFormat:=6

        .Close
    End With

    'save your workbook and quit Excel
    ThisWorkbook.Save = False 'use "True" if you want to save changes
    Application.Quit

    Application.DisplayAlerts = True 'Turn system alert prompts back on(best practice)

OPT2 - Сохранить как .pdf

Dim cpyRng As Range, sPath As String

Application.DisplayAlerts = False 'remove system alert prompts

Set cpyRng = ThisWorkbook.Sheets("Sheet1").Range("A1:C10") 'Change sheet and range as needed

sPath = ThisWorkbook.Path & "\"

    'Change file name to suit
    cpyRng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "Test" & "_" & Format(Date, "yyyymmdd") & _
    ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

Application.DisplayAlerts = True 'Turn system alert prompts back on(best practice)

OPT3 - Сохранить как Word Do c

Dim cpyRng As Range
Set cpyRng = ThisWorkbook.Sheets("Sheet1").Range("A1:C10") 'Change sheet and range as needed

Dim objWord As Object
Set objWord = CreateObject("Word.Application")

    cpyRng.Copy

    With objWord
        .Visible = True
        .Documents.Add
        .Selection.Paste
    End With

Application.CutCopyMode = False

Set objWord = Nothing
0 голосов
/ 08 января 2020

Возможно, вы можете просто пропустить все команды .select и .activate и использовать необязательный параметр Destination функции .copy.

(https://docs.microsoft.com/de-de/office/vba/api/excel.range.copy)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...