сохранение файлов excel по ячейке

[Keaf]

Здравствуйте. Мучаюсь с VBA макросом. Может кто нибудь подскажет другие варианты. Есть ТТН накладная, нужно сохранять в определенную папку по номеру вагона (ячека C5 на листе один) и дате (ячейка D5 на листе один).

Получилось сделать только такой макрос:

Sub SaveAsExample()

Dim FName As String
Dim FPath As String

FPath = "C:"
FName = Sheets("ТТН").Range("С5").Text
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName

End Sub

но никак не могу изменить путь (( только на диск C: сохраняет. И ячеку вторую не могу захватить. Может все таки есть другие варианты

[EducatedFool]

Попробуйте так:

Sub SaveAsExample()
    Dim FName As String, FPath As String
    FPath = "C:\шедевры\Новая папка\"
    
    FName = Sheets("ТТН").Range("c5") & " - " & Sheets("ТТН").Range("d5") & ".xls"
    ThisWorkbook.SaveAs Filename:=FPath & FName
End Sub

Проблема была в том, что в строке Sheets("ТТН").Range("С5").Text
вместо латинской буквы C стояла русская С.

Внимание: папка, указанная в FPath, должна существовать - иначе вылетит ошибка.
В данном примере можно создать папку так:

Sub test2()
    MkDir "C:\шедевры"
    MkDir "C:\шедевры\Новая папка\"
End Sub

[Keaf]

Sub test2()
MkDir "C:\ТТН"
End Sub

Sub SaveAsExample()
Dim FName As String, FPath As String
FPath = "C:\ТТН\"

FName = Sheets("ТТН").Range("c5") & " - " & Sheets("ТТН").Range("d5") & ".xls"
ThisWorkbook.SaveAs Filename:=FPath & FName - выдает ошибку здесь
End Sub

что делать?

[Keaf]

Ура )) получилось

только теперь можно как нибудь автоматизировать процесс, чтобы другие люди не нажимали alt+f8 ?

Sub СоздатьДиректорию()
MkDir "C:\ТТН"
End Sub

Sub СохранитьФайл()
Dim FName As String, FPath As String
FPath = "C:\ТТН\"

FName = Sheets("ТТН").Range("c5") & " - " & Sheets("ТТН").Range("d5") & ".xls"
ThisWorkbook.SaveAs Filename:=FPath & FName
End Sub

[Teslenko_EA]

Здравствуйте Keaf.
подобное изменение кода избавит Вас от таких "ошибок"

Sub test2()
MkDir "C:\ТТН"
End Sub
Sub SaveAsExample()
On Error Resume Next
Dim FName As String, o As Worksheet
Const FPath = "C:\ТТН\"
If Len(Dir(FPath, vbDirectory)) = 0 Then 'каталог не существует
    test2 '
End If
Set o = Sheets("ТТН") 'обращение к листу
If Not o Is Nothing Then 'лист существует
    FName = o.Range("c5") & " - " & o.Range("d5") & ".xls"
    ThisWorkbook.SaveAs Filename:=FPath & FName '- выдает ошибку здесь
    If Err.Number = 1004 Then MsgBox "Canceled"
End If
End Sub

"что делать?" - учиться, набираться опыта и знаний.
Удачи Вам.
Евгений.

[Teslenko_EA]

и снова здравствуйте.
"чтобы другие люди не ..." - разместив на панели инструментов Настраиваемую кнопку из категории Макросы, назначьте ей макрос SaveAsExample. (СохранитьФайл)
Евгений.

[Keaf]

Теперь немножко мне другую задачу поставили ((
FName = o.Range("c5") & " - " & o.Range("d5") & ".xls"

вместо ячейки d5 (в которой была дата) нужно поставить получателя, а он находится в диапазоне ячеек d6:i6

как быть?

[Teslenko_EA]

Keaf измените код процедуры подобным образом:

Sub SaveAsExample(s$)
On Error Resume Next
Dim FName As String, o As Worksheet
Const FPath = "C:\ТТН\"
If Len(Dir(FPath, vbDirectory)) = 0 Then 'каталог не существует
   ' test2 '
End If
Set o = Sheets("ТТН") 'обращение к листу
If Not o Is Nothing Then 'лист существует
    FName = o.Range("c5") & " - " + s + ".xls"
    ThisWorkbook.SaveAs Filename:=FPath & FName '- выдает ошибку здесь
End If
End Sub

для получателя вызов процедуры может быть таким:
SaveAsExample "Получатель"
для получателей "находящихся" в диапазоне ячеек таким:

Sub TTT()
Dim o As Object
   For Each o In Range("d6:i6")
      SaveAsExample o.Text
   Next 
End sub

Евгений.

[Keaf]

Ну вот весь скрипт:

Sub СоздатьКаталог()
MkDir "C:\ТТН"
End Sub
Sub Сохранить(s$)
On Error Resume Next
Dim FName As String, o As Worksheet
Const FPath = "C:\ТТН\"
If Len(Dir(FPath, vbDirectory)) = 0 Then 'каталог не существует
СоздатьКаталог '
End If
Set o = Sheets("ТТН") 'обращение к листу
If Not o Is Nothing Then 'лист существует
FName = o.Range("c5") & " - " + s + ".xls"
ThisWorkbook.SaveAs Filename:=FPath & FName
End If
End Sub
Sub TTT()
Dim o As Object
For Each o In Range("d6:i6")
Сохранить o.Text
Next
End Sub


теперь происходить следующее: файл созраняется до бесконечности и просит заменить его

FName = o.Range("c5") & " - " + s + ".xls" - вот здесь вроде бы нормально, но текст берется только с ячеки C5, а после "-" ничего, хотя должно быть так: текст из C5 потом "-" и текст из объединенных ячеек d6:i6

Как сделать не могу понять ((

[Keaf]

кстати, диапазон ячеек d6:i6 содержит данные типа:
ООО "Организация"

по моему косяк именно в этом ((