Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос создания или открытия книги в папке по условию
 
#1
23.06.2017 11:57:18
Всем доброго времени суток!

Я все еще мучаюсь с одним макросом первую часть, которого мне помогли написать здесь. Совсем я еще чайник в VBA(((
Вот есть код
Код
Sub Main()
     
    Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
    
    Dim strFolder As String
    
    strFolder = "M:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value
    
    If Dir(strFolder, vbDirectory) = "" Then
        MkDir strFolder
    End If
    
 Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    New_Wb.SaveAs "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm", 52
    
    Папка = "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\"
Имя = Dir(Папка & "*.xls*")
Do While Имя <> ""
If Имя <> "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm" Then MkDir New_Wb Else Workbooks.Open Filename:="M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm"
Имя = Dir
Loop
   
   Windows("Расчет.xlsm").Activate
    
End Sub


Суть в том, что по макросу создается папка с определенным названием, а затем в этой папке создается книга, куда потом будут копироваться листы из первоначального файла, тоже с определенным названием. Но эта книга должна создаваться, если такой (с таким названием) еще нет...
Но он не работает((
Выдает окошко с вопросом: файл с таким названием уже есть, заменить? Я нажимаю нет, и дальше ошибка на строку New_Wb. Save As

Помогите, пожалуйста :oops:

P.S. Такая тема уже есть вот здесь. Я просто думаю, может и здесь какие идеи будут)))
Изменено: Honey - 23.06.2017 12:00:21
 
 
 
#2
23.06.2017 11:59:27
Цитата
Honey написал: Я нажимаю нет
Почему нажимаете "нет"?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
23.06.2017 12:03:38
JayBhagavan,
Если нажму да, а туда уже успели скопировать лист из первоначальной книги (Расчет), данные потеряются. А мне нужно чтобы они накапливались...
Название книги это дата и ФИО, а листы это будут работы сотрудников...
 
 
 
#4
23.06.2017 12:43:12
Uraaa!!!
:D
Код
Sub Main()
     
    Const strRootFolder As String = "M:\Production\Masters\2017\Normalization
    
    Dim strFolder As String
    
    strFolder = "M:\Production\Masters\2017\Normalization\" & Range("folder_name").Value
    
    If Dir(strFolder, vbDirectory) = "" Then
        MkDir strFolder
    End If
    
     Dim strFileName As String

   Dim strFileTitle As String


   strFileTitle = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"

   strFileName = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"

   If Dir(strFileName) <> "" Then

      MsgBox "OK"

   Else

 Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    New_Wb.SaveAs "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm", 52
    End If
   
   Windows("Расчет.xlsm").Activate
    
End Sub


Всем спасибо!!! :D
 
 
 
Страницы: 1
Наверх