Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » SanMiguel
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Макрос вставить скопированную строку в первую свободную строку
 
#
22.05.2020 17:17:45
Всё, сдаюсь.
Максимум что удалось допилить, это то, что они идут со столбца B.
Но ошибки следующие:
1. Почему-то задает в пустые ячейки B и C формулу приравнивания к ячейкам во вкладке "Доверенность".
2. Зато правильно вставляет последнюю ячейку D с датой (но мне нужна не формула, а значение)
Код
Sub Печать()
' Печать Макрос

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Sheets("Реестр доверенностей").Select
    Range("B2:D2").Select
    Selection.Copy
    Cells(ActiveCell.Row, 2).Resize(, 3).Copy Cells(Rows.Count, 2).End(xlUp)(2)
    Range("B2").Select
    Application.CutCopyMode = False
    Range("A3:D3").Select
    Sheets("Доверенность").Select
    Range("U1").Select
End Sub
Изменено: SanMiguel - 22.05.2020 17:18:21
 
Перейти    
Макрос вставить скопированную строку в первую свободную строку
 
#
22.05.2020 14:15:57
Всем привет!

Аналогичный вопрос поднимался в теме https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=93380.

Задача. Создать макрос печати доверенности с записью во вкладку реестр информации о печати доверенности.

Решение. Частично всё получается. Нажимаю на кнопку "Печать" - срабатывает макрос и выполняются следующие действия:
1. Печатается форма доверенности
2. Переходит на вкладку "Реестр доверенностей"
3. Копирует ячейки B2:D2
4. Вставляет эти данные в пустые строки (от столбца B) Вот здесь происходит затуп у меня
5. Выбирает пустую ячейку А3 (просто, чтобы курсор не остался в ячейке с формулой)
6. Возвращается на вкладку "Доверенность"

Проблема. Копируются не те ячейки и вставляется формулой. А мне нужно именно вставить значения, чтобы они навсегда сохранились в этой строке. Чтобы дата была уже не формулой "Сегодня()", а значением (константой).

Пользовался кодом, который подсказал kuklp
Цитата
kuklp написал:
Cells(ActiveCell.Row, 1).Resize(, 9).Copy Cells(Rows.Count, 1).End(xlUp)(2)

Вот мой код:
Код
Sub Печать()
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Sheets("Реестр доверенностей").Select
    Range("B2:D2").Select
    Selection.Copy
    Cells(ActiveCell.Row, 1).Resize(, 9).Copy Cells(Rows.Count, 1).End(xlUp)(2)
    Range("B2").Select
    Application.CutCopyMode = False
    Range("A3:D3").Select
    Sheets("Доверенность").Select
    Range("U1").Select
End Sub

Буду признателен за помощь :)
 
Перейти    
Макрос не может найти библиотеку Microsoft Word Object Library
 
#
19.03.2020 13:05:00
Приветствую!

Макрос для выгрузки данных из Excel в Word. Проблема вот в чем:

Макрос прекрасно работает в версиях Excel 2016/2019. Но в Excel 2010 не может найти библиотеку Microsoft Word 16.0 Object Library – пишет MISSING. Если ручками убрать библиотеку 16.0 и поставить 14.0, то макрос запускается. Я как понял, нужно использовать позднее связывание, но куда его запилить ума не приложу.
Ругается на 3 строку (Public AppWord As Word.Application, iWord As Word.Document).
Буду признателен за помощь.

Код
Option Explicit
Option Private Module

Public AppWord As Word.Application, iWord As Word.Document



Sub CreateDoc()
Dim MyArray(), BasePath As String, iFolder As String, iTemplate As String
Dim tmpArray, tmpSTR As String, iRow As Long, iColl As Long, i As Long, j As Long, q As Long

Application.ScreenUpdating = 0
On Error GoTo iEnd

iFolder = Range("FILE_WORD").Value: If Right(iFolder, 1) <> "\" Then iFolder = iFolder & "\"
iTemplate = Range("FILE_TEMPLATE").Value: If Right(iTemplate, 1) = ";" Then iTemplate = Left(iTemplate, Len(iTemplate) - 1)
BasePath = ThisWorkbook.Path & "\Result\": Call FolderCreateDel(BasePath)

With Sheets("data")
    iRow = .UsedRange.Row + .UsedRange.Rows.Count - 1: iColl = .UsedRange.Column + .UsedRange.Columns.Count - 1
    MyArray = .Range(.Cells(1, 1), .Cells(iRow, iColl)).Value
End With

'создаем скрытый объект Word
Set AppWord = CreateObject("Word.Application"): AppWord.Visible = False

'перебираем массив
For i = 2 To iRow
    If MyArray(i, 1) = "ok" Then
    
        'перебираем указанные word-шаблоны
        tmpArray = Split(MyArray(i, 3), ";")
        For q = 0 To UBound(tmpArray)
            tmpSTR = iFolder & tmpArray(q) & ".docx"
            If Len(Dir(tmpSTR)) > 0 Then
                Set iWord = AppWord.Documents.Open(tmpSTR, ReadOnly:=True)
            
                'делаем замену переменных
                For j = 4 To iColl
                    Call ExportWord(MyArray(1, j), MyArray(i, j))
                Next j
                
                iWord.SaveAs Filename:=BasePath & MyArray(i, 2) & " - " & tmpArray(q) & ".docx", FileFormat:=wdFormatXMLDocument
                iWord.Close False: Set iWord = Nothing
            End If
            'tmpSTR = ""
        Next q
        'Erase tmpArray

    End If
Next i

AppWord.Quit: Set AppWord = Nothing
'Erase MyArray: BasePath = "": iFolder = "": iTemplate = ""

Application.ScreenUpdating = 1
MsgBox "Файлы сформированы.", vbInformation

Exit Sub

iEnd:
    AppWord.Quit: Set AppWord = Nothing
    'Erase MyArray: BasePath = "": iFolder = "": iTemplate = ""
    Application.ScreenUpdating = 1
    MsgBox "При обработке данных возникла ошибка.", vbCritical
End Sub
 
Перейти    
Страницы: 1
Loading...