Sanja, все работает! Еще добавил чтобы с двух листов копировались данные.
Скрытый текст |
|---|
| Sub SelectFileAndCopy() Dim MyFile As String Dim iWb As Workbook Application.ScreenUpdating = False Application.EnableEvents = False On Error Resume Next 'Select file(s) in Mac Excel, you are only able to select the file format that you want, 'with this custom GetOpenFilename function, the built-infunction is not working correct on the Mac 'Ron de Bruin, 9-Dec-2024. For more info visit the webpage below ' 'The first argument is the Folder that opens by default, If the second argument is False you be able to select more than one file, If True only one file, the third argument is the file filter 'In this example you are only be able to select xls, xlsx and xlsm files, other examples you can find on my webpage MyFile = GetOpenFileNameMac(ThisWorkbook.Path, False, _ "{""com.microsoft.Excel.xls"",""org.openxmlformats.spreadsheetml.sheet"",""org.openxmlformats.spreadsheetml.sheet.macroenabled""}") If bIsBookOpen(MyFile) = False Then Set iWb = Workbooks.Open(MyFile) ElseIf MsgBox("Файл " & MyFile & " уже открыт. Продолжить работу с ним?", vbQuestion + vbYesNo, "Внимание!") = vbNo Then Exit Sub End If 'If MsgBox("Загрузить данные на лист?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub With ThisWorkbook.Worksheets("лист1") .Range("A1:BA60").Cells.Clear iWb.Worksheets("blank").Range("A1:BA60").Copy .Range("A2") 'iWb.Close Fasle End With With ThisWorkbook.Worksheets("лист2") .Range("A2:H10000").Cells.Clear iWb.Worksheets("tt_list").Range("A1:E60").Copy .Range("A2") iWb.Close Fasle End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub Function GetOpenFileNameMac(StartFolder As String, OneFile As Boolean, FileFilter As String) As String 'Select file(s) in Mac Excel, you are only able to select the file format that you want, 'Ron de Bruin, 9-Dec-2024. For more info visit the webpage below ' On Error Resume Next If OneFile = True Then MyScript = _ "set theFile to (choose file of type" & _ " " & FileFilter & " " & _ "with prompt ""Please select a file"" default location alias POSIX file (""" & _ StartFolder & """) " & "without multiple selections allowed) as string" & vbNewLine & _ "return posix path of theFile" Else MyScript = _ "set theFiles to (choose file of type" & _ " " & FileFilter & " " & _ "with prompt ""Please select a file or files"" default location alias POSIX file (""" & _ StartFolder & """) " & "with multiple selections allowed)" & vbNewLine & _ "set thePOSIXFiles to {}" & vbNewLine & _ "repeat with aFile in theFiles" & vbNewLine & _ "set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _ "end repeat" & vbNewLine & _ "set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _ "set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _ "set text item delimiters to TID" & vbNewLine & _ "return thePOSIXFiles" End If GetOpenFileNameMac = MacScript(MyScript) On Error GoTo 0 End Function Function bIsBookOpen(ByRef szBookName As String) As Boolean On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function |
