Переименование имени файла при его сохранении в сучае совпад - Страница 2

Старая форма входа

Страница 2 из 2 « 1 2
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Переименование имени файла при его сохранении в сучае совпад (Макросы/Sub)

Переименование имени файла при его сохранении в сучае совпад

Влад777

Дата: Суббота, 26.12.2015, 11:14 | Сообщение № 21

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

RAN, В вашем варианте, по моему, не срабатывает цикл в принципе....Макрос просто берет имя файла из ячейки СТ2 и пытается под ним сохранить...

Ответить

RAN

Дата: Суббота, 26.12.2015, 11:31 | Сообщение № 22

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Ну, забыл точку прислюнявить.
Первый макрос ее сам в имени файла находил.

[vba]

Код

Do While Dir(sBaseNameNew & ".xls") <> ""

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Суббота, 26.12.2015, 11:32

Ответить

Влад777

Дата: Суббота, 26.12.2015, 12:02 | Сообщение № 23

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

RAN, Огромное спасибо!!!! Все работает...Маленький штрих...Как вернуть ячейке СТ2 в новом файле имя данного файла. Например наш файл сохранился под именем Профиль(5). Мне надо чтобы в ячейке Ст2 имя Профиль стало Профиль(5), как имя сохраненного файла. Раньше у меня было что-то типа

[vba]

Код

Range("ct2")=Filename

[/vba]

в конце данного макроса. А как сейчас будет выглядеть эта строка?

Ответить

Roman777

Дата: Суббота, 26.12.2015, 12:04 | Сообщение № 24

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, я думал, что в ячейку у Вас сохраняется имя, причем имя предыдущего файла, поэтому казалось всё попроще:
[vba]

Код

       If Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" Then
        If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then
           Do
           i = i + 1
           NameFile = Left(NameFile, Len(NameFile) - 1) & i
           Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> ""
           i = 0
        Else
           Do
           i = i + 1
           If i = 1 Then
              NameFile = NameFile & "_" & i
           Else
              NameFile = Left(NameFile, Len(NameFile) - 1) & i
           End If
           Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> ""
           i = 0
        End If
        End If

[/vba]

Много чего не знаю!!!!

Ответить

Влад777

Дата: Суббота, 26.12.2015, 12:18 | Сообщение № 25

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Roman777, Добавил вашу часть в свой макрос

[vba]

Код

Windows("Пример.xlsx").Activate
Set wb3 = Workbooks("Пример.xlsx")
shName = wb3.ActiveSheet.Name
Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("CT2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
     If Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" Then
        If IsNumeric(Right(namefile, 1)) And Left(Right(namefile, 2), 1) = "_" Then
        Do
        i = i + 1
        namefile = Left(namefile, Len(namefile) - 1) & i
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> ""
        i = 0
        Else
        Do
        i = i + 1
        If i = 1 Then
            namefile = namefile & "_" & i
        Else
            namefile = Left(namefile, Len(namefile) - 1) & i
        End If
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> ""
        i = 0
        End If
        End If
ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Range("ct2") = namefile

[/vba]

Ошибка на
[vba]

Код

ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

[/vba]

Ответить

Roman777

Дата: Суббота, 26.12.2015, 13:13 | Сообщение № 26

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, а что пишет при ошибке? и при дебаге можете глянуть какое значение у namefile
кстати, изначально задумывалось, что namefile задаётся из ячейки CT2? у Вас не вижу этого в коде.
[vba]

Код

namefile = Range("CT2")

[/vba]
перед самим циклом поиска уникального имени.

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Суббота, 26.12.2015, 13:16

Ответить

Влад777

Дата: Суббота, 26.12.2015, 14:39 | Сообщение № 27

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Ура! Все работает!! Вот такой вариант получился

[vba]

Код

Windows("Пример.xlsm").Activate
Set wb3 = Workbooks("Пример.xlsm")
shName = wb3.ActiveSheet.Name
cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Range("CT2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    namefile = Range("CT2")
If Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" Then
        If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then
        Do
        i = i + 1
        NameFile = Left(NameFile, Len(NameFile) - 1) & i
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> ""
        i = 0
        Else
        Do
        i = i + 1
        If i = 1 Then
            NameFile = NameFile & "_" & i
        Else
            NameFile = Left(NameFile, Len(NameFile) - 1) & i
        End If
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> ""
        i = 0
        End If
        End If
ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Range("ct2")=namefile
ActiveWorkbook.Save

[/vba]

Ответить

Влад777

Дата: Суббота, 26.12.2015, 14:40 | Сообщение № 28

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Roman777, Большое спасибо! С наступающим новым годом!

Ответить

Влад777

Дата: Суббота, 26.12.2015, 14:41 | Сообщение № 29

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

RAN, Большое спасибо за ваш вариант...С наступающим!

Ответить

Влад777

Дата: Вторник, 29.12.2015, 13:21 | Сообщение № 30

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Roman777, Добрый день! Такой момент. До 10 файлы нумеруются корректно. Однако, после 10 получается такое имя, например - "НЕПОИМЕНОВАННО_111", "НЕПОИМЕНОВАННО_1112" и т.д. Не подскажите, как это исправить?

Ответить

Roman777

Дата: Вторник, 29.12.2015, 14:51 | Сообщение № 31

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, Всё дело в этой фразе:
[vba]

Код

If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then

[/vba]
что-то я смотрю, и у меня получается не оч красиво. Проблема в поиске определяющиего критерия которое говорит, есть ли в имени уже цифра эта или нет =)
[vba]

Код

If instr(1, NameFile, "_") >0 Then

[/vba]
приношу извинения за косяки.

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 29.12.2015, 14:52

Ответить

Влад777

Дата: Вторник, 29.12.2015, 15:04 | Сообщение № 32

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Roman777, правильно я понял: надо первую строчку вашего ответа заменить на вторую?

Ответить

Roman777

Дата: Вторник, 29.12.2015, 20:09 | Сообщение № 33

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, да)

Много чего не знаю!!!!

Ответить

Wasilich

Дата: Вторник, 29.12.2015, 22:37 | Сообщение № 34

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Может так будет работать.

Сообщение отредактировал Wasilic - Вторник, 29.12.2015, 22:39

Ответить

Roman777

Дата: Среда, 30.12.2015, 11:31 | Сообщение № 35

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, я ещё раз звиняюсь, всё-таки непрально Вам подсказал, вернее частично правильно. В общем получилась у меня крайне муторная и... вродебы должна работать):
[vba]

Код

If Dir("C:\Users\Abinov\Desktop\Новая папка\") <> "" Then
        If InStr(1, StrReverse(NameFile), "_") > 0 And IsNumeric(Right(NameFile, InStr(1, StrReverse(NameFile), "_") + 1 * (InStr(1, StrReverse(NameFile), "_") > 0))) Then
        Do
        i = i + 1
        NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> ""
        i = 0
        Else
        Do
        i = i + 1
        If i = 1 Then
            NameFile = NameFile & "_" & i
        Else
            NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i
        End If
        Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> ""
        i = 0
        End If
        End If
ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & NameFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Range("ct2") = NameFile
ActiveWorkbook.Save

[/vba]

Много чего не знаю!!!!

Ответить

Влад777

Дата: Среда, 30.12.2015, 13:44 | Сообщение № 36

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Roman777, день добрый! Я, честно, не виноват - оно само :)))) Теперь данный макрос ко всем именам файлов приписывает единицу

На имена свыше 10 пока не могу протестировать..не попалось пока такого имени...

Ответить

Влад777

Дата: Среда, 30.12.2015, 13:45 | Сообщение № 37

Группа: Пользователи

Ранг: Участник

Сообщений: 61

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Wasilic, добрый день! Ваш вариант работает, но пока не могу протестировать на имена свыше 10...Большое спасибо!

Ответить

Roman777

Дата: Среда, 30.12.2015, 14:03 | Сообщение № 38

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Влад777, Странно) у меня всё ОК. А имя какое у Вас?
я проверил даже Af_a_6 тоже работает норм =)
Файлик прицепил, там только переменную path измените) и можете изменить кол-во циклов... просто мб я не оч понял Вашу задачу.