Сохранить два листа из книги в новую книгу.

Автор Mailo, 02.07.2011, 12:36

« назад - далее »

Mailo

Здравствуйте. Оговорюсь сразу, что я не программист. Нужна ваша помощь в написании макроса . Собственно сам макрос уже есть, а надо его чуть-чуть адаптировать  под меня))))
В общем, это макрос который сохраняет два нужных мне листа из книги в новую книгу  текущую директорию с нужным мне именем. С этим все в порядке.
Но есть еще два условие:
1)   новая сформированная книга должна быть без макросов
2)   новая книга не должна иметь формул. То есть только результаты вычислений.
А вот и сам макрос:
Private Sub My_MkDir(iPath$)
iStart& = 1 '3
iPathSeparator$ = Application.PathSeparator '"\"
iPath$ = iPath$ & _
IIf(Right(iPath$, 1) = iPathSeparator$, "", iPathSeparator$)
Do
iStart& = InStr(iStart& + 1, iPath$, iPathSeparator$)
iTempPath$ = Mid(iPath$, 1, iStart&)
If Dir(iTempPath$, vbDirectory) = "" Then _
MkDir iTempPath$
Loop While iStart& <> 0
End Sub

Sub Divide_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

Application.ScreenUpdating = False
Application.EnableEvents = False

DateString = Format(Now, "dd-mm-yy")
Set WbMain = ActiveWorkbook

FolderName = WbMain.Path & "\saves"
My_MkDir FolderName

Worksheets(Array("sf", "akt")).Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName & Worksheets("sf").Range("sf!g4") & "счет_фактура" & DateString & ".xls"
Wb.Close False


Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub



Спасибо.

ЗЫ:Поясню почему в новой книге не должно быть макросов. Дело в том что в исходном коде листов которые мы отправляем в новую книгу ести код типа:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Column = 1 Or 2 Or 3 Or 4  Then Application.Run "скрыть_столбец"
End Sub

То есть, когда пользователь кликает по ячейкам в листе обновляется  макрос "скрыть столбец". А этого в новой книге не нужно. И еще в книге есть макрос "сумма прописью", но когда листы отправляем в новую книгу вместо суммы прописью получаем: ####.
Надеюсь внятно объяснил)))

kuklp

#1
Привожу кусок кода, к-рый надо поменять(в настройках должно быть отмечено - доверять доступ к Visual Basic Project):

Worksheets(Array("sf", "akt")).Copy
Set Wb = ActiveWorkbook
Wb.SaveAs FolderName & Worksheets("sf").Range("sf!g4") & "счет_фактура" & DateString & ".xls"
Wb.Close False

Меняем на

Worksheets(Array("sf", "akt")).Copy
Set Wb = ActiveWorkbook
Dim oVBComponent As Object
        For Each oVBComponent In Wb.VBProject.VBComponents
           With oVBComponent
               Select Case .Type
               Case 100: .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
               End Select
           End With
       Next
For Each sh In Wb.Sheets
        sh.UsedRange.Value = sh.UsedRange.Value
Next
Wb.SaveAs FolderName & Worksheets("sf").Range("sf!g4") & "счет_фактура" & DateString & ".xls"
Wb.Close False
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Mailo

спасибо,KuklP.
В сохраненном файле все ячейки с формулами превратились в ячейки с конкретным значением.это как раз то что и требовалось.и макросов файл не содержит.
но одна ячейка akt!c29 ссылалась на макрос "сумма прописью" то есть "=сумма_прописью(I28)" и теперь в этой ячейке не текст а #ИМЯ?
((((
как бы это исправить?)

kuklp

А мне откуда знать? Давайте файл на вскрытие(правила прочитайте).
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Mailo

Сори)Вот файл
Кстати если Вы поможите мне в решении проблемы изложненной в теме :
https://forum.msexcel.ru/microsoft_excel/avtozapusk_makrosa-t5893.0.html
буду еще больше признателен.Файл тот же

Mailo

может у меня макрос "сумма  прописью" не очень удачный?на некоторых компьютерах мне жаловались что не запускается. офис 2003

kuklp

#6
В другой теме Вам уже ответили. Я Вам еще чуть изменил макрос скрыть_столбец.
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Mailo

Спасибо, KuklP.
Все отлично.вот только одно.
Когда жмешь на кнопку сохранить файл сохраняется без макросов. Но тем не менее перед открытием сохраненного файла офис сообщает что в файле есть макросы и предлагает их отключить или нет.
Я думал, что это из-за того что в файле есть кнопки ссылающиеся на макросы.Добавил в наш макрос :
ActiveSheet.Shapes("Button 2").Select
Selection.Cut
ActiveSheet.Shapes("Drop Down 1").Select
Selection.Cut
Sheets("akt").Select
ActiveSheet.Shapes("Button 1").Select
Selection.Cut
Кнопки исчезли, но тем не мение офис сообщает, что в файле макрос(
есть идеи?
Спасибо еще раз!

kuklp

Удаление форм можно короче.
В участок кода:
For Each sh In Wb.Sheets
         sh.UsedRange.Value = sh.UsedRange.Value
Next

Добавим:
For Each sh In Wb.Sheets
         sh.UsedRange.Value = sh.UsedRange.Value
         sh.DrawingObjects.Delete
Next

А по поводу идей - поставьте антивирус и в Эксе степень безопасности Низкая. Да и не так уж хлопотно один раз ткнуть кноку.
Я там еще чуток сократил макрос.
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Mailo

дело не в хлопотах.Просто если кому-либо отправить файл со счет фактурой и актом по эл.почте , то у того кто примет письмо возникнут сомнения: открывать ли этот файл))))
ну ладно.это мелочи)
спс