vba: сохранить в формате xlsm без изменения активной книги

У меня есть следующий код, который делает копии активной книги и дает каждой копии другое имя. Это работает хорошо, НО мне действительно нужен исходный рабочий лист, из которого запускается код, чтобы оставаться активным.

Если вместо этого я использую функцию SaveCopyAs, скопированные файлы будут иметь неправильный формат файла (.xlsm), и вы не сможете указать формат файла в качестве параметра, как в функции saveAs.

http://msdn.microsoft.com/en-us/library/bb178003%28v=office.12%29.aspx

http://msdn.microsoft.com/en-us/library/office/ff841185%28v=office.15%29.aspx

    Sub makeCopies()
        Dim name As Range, team As Range
        Dim uName As String, fName As String, fFormat As String
        Dim location as string, nName as string

        location ="c:\test\"
        nName = "Test - Team "
        Set team = Names("Team").RefersToRange

        For Each name In team
            uName = nName & name.Value
            fName = location & uName
            fFormat = ThisWorkbook.FileFormat
            ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=fFormat
        Next name
   End sub

Лучшее, что я могу придумать, это сначала сделать копии с помощью saveCopyAs, а затем получить доступ к каждому файлу, сохранить его в правильном формате файла с помощью saveAs, а затем закрыть его, но это означает двойную работу, и я бы очень не хотел этого делать. Есть ли более разумный способ?


person Miqi180    schedule 08.08.2014    source источник
comment
Ну, как это бывает, я действительно делаю. Это именно то, что делает параметр FileFormat, пожалуйста, обратитесь к моей второй ссылке в сообщении и msdn.microsoft.com/en-us/library/office/   -  person Miqi180    schedule 09.08.2014


Ответы (1)


Это работает для меня. SaveCopyAs сохраняет книгу в точно таком же формате.

Sub makeCopies()
    Dim name As Range, team As Range
    Dim uName As String, fName As String, tempname As String
    Dim location As String, nName As String

    location = "C:\Test\"
    nName = "Test - Team "
    Set team = ThisWorkbook.Names("Team").RefersToRange

    For Each name In team
        uName = nName & name.Value
        fName = location & uName & "." & _
            Split(ThisWorkbook.FullName, ".") _
            (UBound(Split(ThisWorkbook.FullName, ".")))
        ThisWorkbook.SaveCopyAs fName
    Next name
End Sub

Это то, что вы пытаетесь? Пробовал и тестировал.

person L42    schedule 09.08.2014
comment
Интересно, если это работает. Я попробую и вернусь. Я думаю, что вы сделали небольшую ошибку с временным именем var. Вы его нигде не используете... - person Miqi180; 09.08.2014
comment
@ Miqi180 Miqi180 Да, я проверил это, используя другой подход :) Если это сработает, что, я думаю, сработает, нам не придется прибегать к этому: D - person L42; 09.08.2014
comment
хрмм, я думаю, мой компьютер, должно быть, заболел гриппом или чем-то еще, потому что, клянусь, функция saveCopyAs была первым, что я попробовал, включая установку расширения файла в виде строки (.xlms) и добавление его в конец имени файла. Это полностью эквивалентно тому, что вы делаете, за исключением того, что ваш код является динамическим и будет работать для всех расширений файлов. Во всяком случае, теперь он работает так, как ожидалось. Спасибо. Хороший звонок! :) - person Miqi180; 09.08.2014