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

Вход

Регистрация

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

 

= Мир MS Excel/В ячейку вставляется имя файла через раз - Мир MS Excel

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

Excel 2013
Доброго времени суток, подскажите пожалуйста почему через раз вставляется данные в ячейку N38 и далее при выборе файлов через диалоговое окно, код вроде так не должен работать, но почему-то он ведет себя иначе, где-то здесь пробел:
[vba]
Код
Do
Range("N37").Select
Do
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
With Application.FileDialog(msoFileDialogFilePicker)
    .ButtonName = "Добавить прилагаемые"
    
    
    If .Show = 0 Then
    
        Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add
    
    Range("N13:W50").Copy
    wdApp.Visible = True
    wdApp.Documents.Add
    'wdApp.Selection.PasteAndFormat (wdFormatDocument)
    wdDoc.Range(0).Paste
    wdDoc.SaveAs q & Range("A8").Value & ".doc"
    wdDoc.Close True
    wdApp.Quit
    'wdApp.PrintOut Copies:=1, ActivePrinter:="Microsoft print to pdf"
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
    Exit Sub
    Else
    End If
   
    
    
    ReDim arrFiles(1 To .SelectedItems.Count)
    For i = 1 To .SelectedItems.Count
        arrFiles(i) = .SelectedItems(i)
    Next i
End With

For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
    ActiveCell.Offset(i - 1, 0).Value = CreateObject("Scripting.FileSystemObject").GetFileName(arrFiles(i))
Next i
Loop Until Application.FileDialog(msoFileDialogFilePicker).Show = 0

    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add
    
    Range("N13:W50").Copy
    wdApp.Visible = True
    wdApp.Documents.Add
    'wdApp.Selection.PasteAndFormat (wdFormatDocument)
    wdDoc.Range(0).Paste
    wdDoc.SaveAs q & Range("A8").Value & ".doc"
    wdDoc.Close True
    wdApp.Quit
    'wdApp.PrintOut Copies:=1, ActivePrinter:="Microsoft print to pdf"
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
[/vba]
К сообщению приложен файл: 1112.xlsm (0.0 Kb)
 
Ответить
СообщениеДоброго времени суток, подскажите пожалуйста почему через раз вставляется данные в ячейку N38 и далее при выборе файлов через диалоговое окно, код вроде так не должен работать, но почему-то он ведет себя иначе, где-то здесь пробел:
[vba]
Код
Do
Range("N37").Select
Do
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
With Application.FileDialog(msoFileDialogFilePicker)
    .ButtonName = "Добавить прилагаемые"
    
    
    If .Show = 0 Then
    
        Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add
    
    Range("N13:W50").Copy
    wdApp.Visible = True
    wdApp.Documents.Add
    'wdApp.Selection.PasteAndFormat (wdFormatDocument)
    wdDoc.Range(0).Paste
    wdDoc.SaveAs q & Range("A8").Value & ".doc"
    wdDoc.Close True
    wdApp.Quit
    'wdApp.PrintOut Copies:=1, ActivePrinter:="Microsoft print to pdf"
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
    Exit Sub
    Else
    End If
   
    
    
    ReDim arrFiles(1 To .SelectedItems.Count)
    For i = 1 To .SelectedItems.Count
        arrFiles(i) = .SelectedItems(i)
    Next i
End With

For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
    ActiveCell.Offset(i - 1, 0).Value = CreateObject("Scripting.FileSystemObject").GetFileName(arrFiles(i))
Next i
Loop Until Application.FileDialog(msoFileDialogFilePicker).Show = 0

    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add
    
    Range("N13:W50").Copy
    wdApp.Visible = True
    wdApp.Documents.Add
    'wdApp.Selection.PasteAndFormat (wdFormatDocument)
    wdDoc.Range(0).Paste
    wdDoc.SaveAs q & Range("A8").Value & ".doc"
    wdDoc.Close True
    wdApp.Quit
    'wdApp.PrintOut Copies:=1, ActivePrinter:="Microsoft print to pdf"
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
[/vba]
Автор - Asretyq
Дата добавления - 29.10.2017 в 21:50
KuklP Дата: Воскресенье, 29.10.2017, 22:43 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
В аттаче файл нулевой длины. Перезалейте.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеВ аттаче файл нулевой длины. Перезалейте.
Автор - KuklP
Дата добавления - 29.10.2017 в 22:43
Asretyq Дата: Воскресенье, 29.10.2017, 22:49 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Извиняюсь, видимо не загрузился, перезалил
К сообщению приложен файл: 4048796.xlsm (29.2 Kb)
 
Ответить
СообщениеИзвиняюсь, видимо не загрузился, перезалил
Автор - Asretyq
Дата добавления - 29.10.2017 в 22:49
KuklP Дата: Воскресенье, 29.10.2017, 23:19 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Там весь код сплошной безграмотный бред. Нет смысла разбираться. Зачем зацикливать диалог с мультиселектом?
зачем каждый раз создавать по 2 дока?
[vba]
Код
      Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add    
   ...
    wdApp.Documents.Add
[/vba]А это вообще Вы откуда такую ересь берете?
[vba]
Код
For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
    ActiveCell.Offset(i - 1, 0).Value = CreateObject("Scripting.FileSystemObject").GetFileName(arrFiles(i))
Next i
[/vba]Зачем создавать гору ненужных объектов? Загадить всю память? После такого комп надо дезинфицировать хлоркой. %)
Так это делается:
[vba]
Код
For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
   Cells(i +37, 23).Value = q & Dir(arrFiles(i))
Next i
[/vba]
ИМХО рано Вам еще за такие проекты браться. Начните с чего-то попроще, почитайте литературу, примеры из книжек погоняйте.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеТам весь код сплошной безграмотный бред. Нет смысла разбираться. Зачем зацикливать диалог с мультиселектом?
зачем каждый раз создавать по 2 дока?
[vba]
Код
      Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add    
   ...
    wdApp.Documents.Add
[/vba]А это вообще Вы откуда такую ересь берете?
[vba]
Код
For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
    ActiveCell.Offset(i - 1, 0).Value = CreateObject("Scripting.FileSystemObject").GetFileName(arrFiles(i))
Next i
[/vba]Зачем создавать гору ненужных объектов? Загадить всю память? После такого комп надо дезинфицировать хлоркой. %)
Так это делается:
[vba]
Код
For i = 1 To UBound(arrFiles)
    FileCopy arrFiles(i), q & Dir(arrFiles(i))
   Cells(i +37, 23).Value = q & Dir(arrFiles(i))
Next i
[/vba]
ИМХО рано Вам еще за такие проекты браться. Начните с чего-то попроще, почитайте литературу, примеры из книжек погоняйте.
Автор - KuklP
Дата добавления - 29.10.2017 в 23:19
Asretyq Дата: Понедельник, 30.10.2017, 06:45 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, спасибо за помощь


Сообщение отредактировал Asretyq - Понедельник, 30.10.2017, 07:14
 
Ответить
СообщениеKuklP, спасибо за помощь
Автор - Asretyq
Дата добавления - 30.10.2017 в 06:45
KuklP Дата: Понедельник, 30.10.2017, 09:00 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Не просили критиковать код? А это что?
Цитата Asretyq, 29.10.2017 в 21:50, в сообщении № 1 ()
код вроде так не должен работать, но почему-то он ведет себя иначе
Дело Ваше..

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНе просили критиковать код? А это что?
Цитата Asretyq, 29.10.2017 в 21:50, в сообщении № 1 ()
код вроде так не должен работать, но почему-то он ведет себя иначе
Дело Ваше..
Автор - KuklP
Дата добавления - 30.10.2017 в 09:00
Asretyq Дата: Понедельник, 30.10.2017, 09:26 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, здесь имелось ввиду описать действие кода, а информация типа
Цитата KuklP, 29.10.2017 в 23:19, в сообщении № 4 ()
Там весь код сплошной безграмотный бред
мне не даст никакой информации, либо ничего не писать. [vba]
Код
Cells(i +37, 23).Value = q & Dir(arrFiles(i))
[/vba] Вот это я не знаю что такое, мне не нужно файлы вставлять в ячейки, мне надо было имя файла вставить в ячейки. Даже не знаю как можно файл вставить в ячейку
 
Ответить
СообщениеKuklP, здесь имелось ввиду описать действие кода, а информация типа
Цитата KuklP, 29.10.2017 в 23:19, в сообщении № 4 ()
Там весь код сплошной безграмотный бред
мне не даст никакой информации, либо ничего не писать. [vba]
Код
Cells(i +37, 23).Value = q & Dir(arrFiles(i))
[/vba] Вот это я не знаю что такое, мне не нужно файлы вставлять в ячейки, мне надо было имя файла вставить в ячейки. Даже не знаю как можно файл вставить в ячейку
Автор - Asretyq
Дата добавления - 30.10.2017 в 09:26
Asretyq Дата: Понедельник, 30.10.2017, 09:27 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, Ладно, это бесполезная трата времени, попробую сам разобраться
 
Ответить
СообщениеKuklP, Ладно, это бесполезная трата времени, попробую сам разобраться
Автор - Asretyq
Дата добавления - 30.10.2017 в 09:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » В ячейку вставляется имя файла через раз (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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