Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сохранить лист отд. файлом имя и пароль открытия по знач.яч - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранить лист отд. файлом имя и пароль открытия по знач.яч (Макросы/Sub)
Сохранить лист отд. файлом имя и пароль открытия по знач.яч
Gjlhzl Дата: Пятница, 07.04.2023, 17:32 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

Помогите с макросом пожалуйста (масса примеров всех задач по отдельности а все вместе не нашел, а как собрать все в кучу не знаю) :
требуется:
задача1 - сохранить лист1 в отдельный файл, имя файлу присвоить по значению ячейки А1 Листа2 + дату в формате месяц.день.год. и время
задача2 - присвоить пароль на открытие файла по значению ячейки В1 Листа2
задача3 - файл сохранить в той директории что и основной файл (Книга1) в подпапках допустим \1\2\ если подпапок нет то создать их
К сообщению приложен файл: kniga1.xlsb (13.9 Kb)
 
Ответить
СообщениеПомогите с макросом пожалуйста (масса примеров всех задач по отдельности а все вместе не нашел, а как собрать все в кучу не знаю) :
требуется:
задача1 - сохранить лист1 в отдельный файл, имя файлу присвоить по значению ячейки А1 Листа2 + дату в формате месяц.день.год. и время
задача2 - присвоить пароль на открытие файла по значению ячейки В1 Листа2
задача3 - файл сохранить в той директории что и основной файл (Книга1) в подпапках допустим \1\2\ если подпапок нет то создать их
Автор - Gjlhzl
Дата добавления - 07.04.2023 в 17:32
VBAdevelope Дата: Среда, 12.04.2023, 13:44 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 4 ±
Замечаний: 20% ±

2013
Gjlhzl, Не нашёл кнопки для оформления кода, поэтому выкладываю так
[vba]
Код
Sub RunMacros()
Dim oWB As Workbook
Dim oNew As Workbook
Dim oSh1 As Worksheet
Dim oSh2 As Worksheet
Dim sPath$, sDate$
Application.ScreenUpdating = False
Set oWB = ActiveWorkbook
Set oSh1 = oWB.Worksheets("Лист1")
Set oSh2 = oWB.Worksheets("Лист2")

sPath = Replace(oWB.FullName, oWB.Name, "")
sDate = Format(Date, "mm.dd.yyyy") & " " & Replace(Time, ":", ".")
sName = oSh2.Range("A1").Value & " " & sDate

Set oNew = Excel.Workbooks.Add
oNew.Worksheets("Лист1").Name = "Todel"
oSh1.Copy After:=oNew.Worksheets("Todel")
Application.DisplayAlerts = False
oNew.Worksheets("Todel").Delete
Application.DisplayAlerts = True
oNew.SaveAs Filename:=sPath & sName & ".xlsx", Password:=oSh2.Range("B1").Value
oNew.Close
Application.ScreenUpdating = True
End Sub
[/vba]

Макросы VBA Excel, Word на заказ.
Сказать спасибо на Юмани: 410015093172871

Сообщение отредактировал Serge_007 - Среда, 12.04.2023, 13:59
 
Ответить
СообщениеGjlhzl, Не нашёл кнопки для оформления кода, поэтому выкладываю так
[vba]
Код
Sub RunMacros()
Dim oWB As Workbook
Dim oNew As Workbook
Dim oSh1 As Worksheet
Dim oSh2 As Worksheet
Dim sPath$, sDate$
Application.ScreenUpdating = False
Set oWB = ActiveWorkbook
Set oSh1 = oWB.Worksheets("Лист1")
Set oSh2 = oWB.Worksheets("Лист2")

sPath = Replace(oWB.FullName, oWB.Name, "")
sDate = Format(Date, "mm.dd.yyyy") & " " & Replace(Time, ":", ".")
sName = oSh2.Range("A1").Value & " " & sDate

Set oNew = Excel.Workbooks.Add
oNew.Worksheets("Лист1").Name = "Todel"
oSh1.Copy After:=oNew.Worksheets("Todel")
Application.DisplayAlerts = False
oNew.Worksheets("Todel").Delete
Application.DisplayAlerts = True
oNew.SaveAs Filename:=sPath & sName & ".xlsx", Password:=oSh2.Range("B1").Value
oNew.Close
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - VBAdevelope
Дата добавления - 12.04.2023 в 13:44
Serge_007 Дата: Среда, 12.04.2023, 13:59 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
VBAdevelope, Как оформлять сообщения?

ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеVBAdevelope, Как оформлять сообщения?
Автор - Serge_007
Дата добавления - 12.04.2023 в 13:59
Gjlhzl Дата: Вторник, 18.04.2023, 13:37 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

VBAdevelope, спасибо. работает
 
Ответить
СообщениеVBAdevelope, спасибо. работает
Автор - Gjlhzl
Дата добавления - 18.04.2023 в 13:37
Gjlhzl Дата: Пятница, 28.04.2023, 19:53 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

VBAdevelope, а как бы подправить, что бы файл сохранялся в папке в той же директории что и основной файл но в папке имя которой береться из ячейки C1
если есть папка то в нее если нет то создать ее
К сообщению приложен файл: 4437224.xlsb (14.9 Kb)
 
Ответить
СообщениеVBAdevelope, а как бы подправить, что бы файл сохранялся в папке в той же директории что и основной файл но в папке имя которой береться из ячейки C1
если есть папка то в нее если нет то создать ее
Автор - Gjlhzl
Дата добавления - 28.04.2023 в 19:53
Pelena Дата: Суббота, 29.04.2023, 14:37 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19392
Репутация: 4537 ±
Замечаний: ±

Excel 365 & Mac Excel
Цитата Gjlhzl, 28.04.2023 в 19:53, в сообщении № 5 ()
в папке имя которой береться из ячейки C1

Попробуйте такой вариант
[vba]
Код
Sub RunMacros1()
    Dim oWB As Workbook
    Dim oNew As Workbook
    Dim oSh1 As Worksheet
    Dim oSh2 As Worksheet
    Dim sPath$, sFolder$, sDate$
    
    Application.ScreenUpdating = False
    Set oWB = ActiveWorkbook
    Set oSh1 = oWB.Worksheets("Лист1")
    Set oSh2 = oWB.Worksheets("Лист2")

    sPath = Replace(oWB.FullName, oWB.Name, "")
    sFolder = sPath & oSh2.Range("C1").Value & IIf(Right(oSh2.Range("C1").Value, 1) = "\", "", "\")
    sDate = Format(Date, "mm.dd.yyyy") & " " & Replace(Time, ":", ".")
    sName = oSh2.Range("A1").Value & " " & sDate
    
    On Error Resume Next
    MkDir sFolder
    On Error GoTo 0

    oSh1.Copy
    Set oNew = ActiveWorkbook
    oNew.SaveAs Filename:=sFolder & sName & ".xlsx", Password:=oSh2.Range("B1").Value
    oNew.Close
    Application.ScreenUpdating = True
End Sub
[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Цитата Gjlhzl, 28.04.2023 в 19:53, в сообщении № 5 ()
в папке имя которой береться из ячейки C1

Попробуйте такой вариант
[vba]
Код
Sub RunMacros1()
    Dim oWB As Workbook
    Dim oNew As Workbook
    Dim oSh1 As Worksheet
    Dim oSh2 As Worksheet
    Dim sPath$, sFolder$, sDate$
    
    Application.ScreenUpdating = False
    Set oWB = ActiveWorkbook
    Set oSh1 = oWB.Worksheets("Лист1")
    Set oSh2 = oWB.Worksheets("Лист2")

    sPath = Replace(oWB.FullName, oWB.Name, "")
    sFolder = sPath & oSh2.Range("C1").Value & IIf(Right(oSh2.Range("C1").Value, 1) = "\", "", "\")
    sDate = Format(Date, "mm.dd.yyyy") & " " & Replace(Time, ":", ".")
    sName = oSh2.Range("A1").Value & " " & sDate
    
    On Error Resume Next
    MkDir sFolder
    On Error GoTo 0

    oSh1.Copy
    Set oNew = ActiveWorkbook
    oNew.SaveAs Filename:=sFolder & sName & ".xlsx", Password:=oSh2.Range("B1").Value
    oNew.Close
    Application.ScreenUpdating = True
End Sub
[/vba]
Автор - Pelena
Дата добавления - 29.04.2023 в 14:37
Gjlhzl Дата: Суббота, 29.04.2023, 21:08 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

Pelena, спасибо
то что нужно!
 
Ответить
СообщениеPelena, спасибо
то что нужно!
Автор - Gjlhzl
Дата добавления - 29.04.2023 в 21:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранить лист отд. файлом имя и пароль открытия по знач.яч (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!