Как выполнить "Эмуляцию F2", до последней заполненной ячейки в столбце код взят отсюда. А почему "Num Lock" отключается?
Код
Sub Emul_F2()
ActiveCell.Select
Dim lCnt As Long
Do While lCnt < 150
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
lCnt = lCnt + 1
Loop
End Sub
Здравствуйте, есть макрос который копирует данные с одной книги в другую. Но возникает проблема при копировании из "Книга1" в "Книга2" , формулы в "Книга2" начинаю ссылаться на "Книга1", а надо чтобы они остались не изменены. Как это сделать подскажите?
Код
Sub vst()
Dim wb As String: wb = ThisWorkbook.Path & "\Книга2.xlsm" 'путь к основной книге (куда копировать)
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
.Visible = False
Workbooks.Open Filename:=wb
ThisWorkbook.Worksheets("Таблица").Cells.Copy ActiveWorkbook.Worksheets("Таблица").Cells 'копируем все данные с активного листа
'Workbooks("Куда.xlsm").Worksheets("Лист1").Range("A1:G25").Copy
ActiveWorkbook.Close (True)
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.Visible = True
End With
End Sub
Здравствуйте подскажите пожалуйста, как здесь прописать относительную ссылку на другой лист а не на активный "TextBox1 = ActiveCell.Range("A1").Offset(0, 0)". Например я на ходился бы на "Лист1" "D5", а данные с формы отображались с "Лист2" "D5"
Здравствуйте подскажите пожалуйста нашёл вот такой макрос, как можно сделать так чтобы сбор данных осуществлялся не со всех листов из выделенных через "ctrl". Сбор данных может осуществлялся с разных листов
Здравствуйте, подскажите пожалуйста как перенести данные с одного столбца "L" в столбец "X" без пустых ячеек, как в примере. Количество строк может быть разное.
Здравствуйте, помогите пожалуйста разобраться. В одной книге работает она была создана 2010 office, из неё скопировал, этот код в книгу 2021 office, и в ней он не работает. Как быть?
Здравствуйте, помогите пожалуйста с такой задачей. На "Лист1" я вызываю форму, там я вбиваю текст "TextBox1", в вожу числа"TextBox2", "TextBox3", "TextBox4", нажимаю кнопку добавить. И нужно, чтобы найти на листе "Список", в столбце "A" последнюю не заполненную ячейку, например "A30", вставить туда из текст "TextBox1", следовательно из "TextBox2" в "B30", "TextBox3" в "C30", "TextBox4" в "D30", но нужно вставить как число. Спасибо кто поможет.
Здравствуйте подскажите, очень нужна помощь. Как в этом коде обойти копирование с выше 255 символов:
Код
Sub ReplaceInWord()
'имя шаблона Word с основным текстом и метками
Const sWDTmpl As String = "Шаблон.docx"
Dim objWrdApp As Object, objWrdDoc As Object, wdRange As Object
Dim IsNeedClose As Boolean
Dim ws As Worksheet
Dim lr As Long, llastr As Long, lc As Long, llastc As Long
Dim sPath As String, sToSavePath As String, sWDTmplFullName As String, sWDDocName As String
Dim sFindVal As String, sReplaceVal As String
On Error Resume Next
'пытаемся подключится к объекту Word
Set objWrdApp = GetObject(, "Word.Application")
If objWrdApp Is Nothing Then
'если приложение закрыто - создаем новый экземпляр
Set objWrdApp = CreateObject("Word.Application")
'делаем приложение видимым. По умолчанию открывается в скрытом режиме
objWrdApp.Visible = True
IsNeedClose = True
End If
'путь к папке с файлом кода
'здесь же должен лежать файл шаблона Word
sPath = ThisWorkbook.Path
'добавляем разделитель папок, если его нет
sPath = IIf(Right(sPath, 1) = Application.PathSeparator, "", sPath & Application.PathSeparator)
'полный путь к файлу шаблона
sWDTmplFullName = sPath & sWDTmpl
'создаем папку для сохранения создаваемых файлов Word
sToSavePath = sPath & Format(Now, "YYYY_MM_DD hh_mm")
If Dir(sToSavePath, 16) = "" Then
MkDir sToSavePath
End If
sToSavePath = IIf(Right(sToSavePath, 1) = Application.PathSeparator, "", sToSavePath & Application.PathSeparator)
Set ws = Sheets("Word(копировать)")
With ws
'определяем последнюю заполненную ячейку на основании столбца А
llastr = .Cells(.Rows.Count, 1).End(xlUp).Row
'определяем последний столбец на основании столбца с метками
llastc = .Cells(1, .Columns.Count).End(xlToLeft).Column
'просмотр начинаем с 3-ей строки, т.к. именно с неё начинаются наши данные
For lr = 3 To llastr
'считываем фамилию с инициалами
sWDDocName = .Cells(lr, 1).Value
If sWDDocName <> "" Then
'заменяем точки на пусто для удобочиатемости имен файлов
sWDDocName = Replace(sWDDocName, ".", "")
'составляем полный путь к создаваемому файлу,
'при этом берем тоже расширение файла, что и шаблона
sWDDocName = sToSavePath & sWDDocName & ".doc"
'создаем новый документ Word на основании шаблона
Set objWrdDoc = objWrdApp.Documents.Add(sWDTmplFullName)
For lc = 1 To llastc
'запоминаем метку для поиска в файле Word
sFindVal = .Cells(1, lc).Value
'этим значением будем заменять текст метки
sReplaceVal = .Cells(lr, lc).Text
Set wdRange = objWrdDoc.Range
'заменяем метки {*} на текст из ячеек
wdRange.Find.ClearFormatting
wdRange.Find.Replacement.ClearFormatting
With wdRange.Find
.Text = sFindVal
.Replacement.Text = sReplaceVal
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdRange.Find.Execute Replace:=2 'wdReplaceAll
Next lc
'сохраняем созданный документ, но не добавляем в список последних открытых
objWrdDoc.SaveAs FileName:=sWDDocName, AddToRecentFiles:=False
'закрываем документ Word
objWrdDoc.Close False
End If
Next
End With
If IsNeedClose Then
'закрываем приложение Word если открывали его кодом
objWrdApp.Quit
End If
'очищаем переменные Word
Set objWrdDoc = Nothing
Set objWrdApp = Nothing
'
MsgBox "Файлы созданы и сохранены в папке '" & sToSavePath & "'", vbInformation, "www.excel-vba.ru"
End Sub
Здравствуйте, подскажите, как решить такую проблемку. У меня на "Лист1" он является титульным листом ориентация книжная количество страниц может быть разное. И "Лист2" он является протоколом ориентация альбомная. Нужно у казать колонтитул на "Лист1" начинаться страница 1 количество страниц может быть разное общее количество страниц должно быть подсчитано из "Лист1" и "Лист2". Например "Лист1" занимает две страницы, "Лист2" занимает семь страниц. Значит на "Лист1", общее количество страниц 9, страница 1. А "Лист2", тоже самое только начинаться должен с учетом "Лист1", то есть с третьей страницы, хотя фактически это будет страница один. Вот так вот.
Здравствуйте, помогите пожалуйста со следующем макросом. Вообщем нужно создать папку в директории из которой запущен макрос, назвать папку как книгу из которой запущен макрос и выполнить следующий макрос в эту книгу
Как автоматически разнести из формы из combobox и Label разнести по ячейкам? Например нужно после выбора из списка Combobox3 автоматически перенести на "Лист3!E15", а из Label24 в "Лист3!G17".
Как на форме обновить label при изменении ComboBox? Например в ComboBox выбираю "яблоко" в label автоматические отображается "растение", в ComboBox выбираю "гвоздь", в label автоматические отображается "металл.
Помогите в следующем вопросе. Как скопировать данные из-за крытой книги вместе с формулами и форматами. в ниже приведенном коде?
Код
Sub Get_Value_From_Close_Book()
Dim sShName As String, sAddress As String, vData
'Отключаем обновление экрана
Application.ScreenUpdating = False
Workbooks.Open "C:\Documents and Settings\Книга1.xls" '"
sAddress = "A1:C100" 'или одна ячейка - "A1"
'получаем значение
vData = Sheets("Лист1").Range(sAddress).Value
ActiveWorkbook.Close False
'Записываем данные на активный лист книги,
'с которой запустили макрос
If IsArray(vData) Then
[A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
Else
[A1] = vData
End If
'если надо копировать ячейки с форматами,
'то можно использовать стандартные методы копирования вставки
'objCloseBook.Sheets("Лист1").Range(sAddress).Copy
'[A1].PasteSpecial xlPasteValues 'вставляем значения
'[A1].PasteSpecial xlPasteFormats 'вставляем форматы
'Включаем обновление экрана
Application.ScreenUpdating = True
End Sub
Здравствуйте прошу помощи в следующем вопросе. У меня есть таблица на листе "СИ", в неё вбиваются название прибора и для каждой поверке прибора выдаётся № свидетельства и дата поверки от и до. Соответственно, когда дата поверки подходит к концу, прибор отправляется в поверку и ему выдают новое № свидетельство и дата поверки от и до. И это происходит, каждый год. На листе "Данные" я выбираю прибор он ВПР мне находит № свидетельства, и потом ввожу дату выполнения. Помощь нужна в следующем, когда я ввожу дату выполнения, то нужно проверить входит ли дата в диапазон в одну из перечисленных поверок. Такие поверки проходят каждый год, то список поверок будет увеличиваться. Я написал следующую формулу =ЕСЛИ(И(C6>СИ!C3;C6<СИ!D3);1;0), но это только для одного диапазона. Можно но ли как то формулой прописать для всех диапазонов???
Здравствуйте, нужна помощь. В книге есть форма, вызываешь её, и в поисковой строке, этой формы вводишь нужный текст, который нужно скрыть. И есть в этой форме еще один макрос, он прикручен к кнопке "показать", но он работает отдельно от формы. А теперь, в чем нужна помощь, прикрутить этот макрос к поисковой строке, на форме, чтобы он показал строки содержащие данный текст, и чтобы он искал этот текст по всему листу??? Макросы взял здесь и здесь.,
Здравствуйте столкнулся с такой проблемой. Нужно пройтись по всем формам и модулям и заменить слово "Титульник" на "ТИТ". Можно это сделать как-то макросом?
Здравствуйте. Нужна Ваша помощь, вообщем я нашел макрос в интернете который копирует данные из закрытой книги, но он получается копирует диапазон, а мне надо, чтобы копировал нужные мне ячейки ("A3","C5","H4", G8"). Вот ссылка на макрос КАК ПОЛУЧИТЬ ДАННЫЕ ИЗ ЗАКРЫТОЙ КНИГИ. Я его не много переделал, вот что получилось:
Код
Sub Копировать_ИЗ()
Dim sShName As String, sAddress As String, vData
Dim objCloseBook As Object
'Отключаем обновление экрана
Application.ScreenUpdating = False
Set objCloseBook = GetObject("D:\Сюда.xlsm")
vData = objCloseBook.Sheets("Поиск").Range("A3","C5","H4", "G8").Value
objCloseBook.Close False
If IsArray(vData) Then
Sheets("Лист1").Range("A3","C5","H4", "G8").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
Else
Sheets("Поиск").Range("A3","C5","H4", G8") = vData
End If
Application.ScreenUpdating = True
End Sub
Но когда я прописываю в макросе вот так:
Код
.Range("A3","C5")
то он копирует, а когда так:
Код
.Range("A3","C5","H4", "G8")
То выдает ошибку. Где мне прописать нужное количество ячеек, для копирования???
Помогите пожалуйста решить такую ситуацию. Создаю "Связанные выпадающие списки", по примеру, который находится по этой ссылки Связанные (зависимые) выпадающие списки. Вроде все получается, но в первом списке есть пробелы и скобки, из-за них не получается создать "Связанные выпадающие списки", как быть? Понятно можно добавить нижнее подчеркивание, а как быть со скобками. И все-таки можно оставить пробелы и скобки? И еще встречный вопрос, если допустим первый список будет редактироваться, то нужно по новому присваивать имена диапазонам, а без этого можно как-то обойтись, например чтобы изменения автоматически вносились созданные в имена диапазона.
Здравствуйте, такая проблема у меня в столбце B:B есть формулы, которые нужно заменить на значение. Проблема в том что в этом столбце есть объеденные ячейки например с B1 по V1 и таких ячеек очень много. Когда я записываю макрос с копировать и вставить значение он вставляет значения во всех ячейках от B до V, а нужно только в столбце B:B. Помогите.
Здравствуйте, помогите с такой проблемой. У меня есть столбец "C", в котором в разных ячейках есть группа символов "$&$", мне нужно их заменить на определенную формулу, так чтобы сохранились относительные ссылки. Например мне нужно в столбце "C" заменить группу символов "$&$", которые находятся в ячейки "C1" на формулу D1=E1, которые находятся в ячейки "С4" на формулу D4=E4, которые находятся в ячейки "C15" на формулу D15=E15 и т.д. Помогите, как это сделать автоматически
Здравствуйте, Подскажите пожалуйста с таким вопросом. Я нашёл в интернете макрос, который удаляет все макросы в активной книге. Вот ссылка: http://www.excel-vba.ru/chto-umeet-excel/kak-udalit-makrosy-v-knige/. Я его скопировал себе в книгу. Проблема в том что, когда я его запускаю он ругается на:
Код
MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
" Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
Здравствуйте. Помогите с возникшим вопросом. Есть excel "файл 1" в него внедрен объект excel файл 2, он находиться в ячейки Лист1!F1 и связан он с ячеками "файла 1" '[Файл 1.xlsm]Лист1'!A1, '[Файл 1.xlsm]Лист1'!B1, '[Файл 1.xlsm]Лист1'!C1. Как можно реализовать идею так, чтобы при копировании внедренного объекта в ячейку Лист1!F2, в нем автоматически менялось связь '[Файл 1.xlsm]Лист1'!A2, '[Файл 1.xlsm]Лист1'!B2, '[Файл 1.xlsm]Лист1'!C2, а если Лист1!F3 '[Файл 1.xlsm]Лист1'!A3, '[Файл 1.xlsm]Лист1'!B32, '[Файл 1.xlsm]Лист1'!C3 и т.д. Можно ли это как то реализовать, выручите меня пожалуйста.
Здравствуйте, подскажите можно ли сделать формулу в VBA, т.е чтобы вычисления проходили в VBA, например за ячейкой A1, закрепить формулу, A2+C2, но чтобы формула не отображалась в самой ячейки.
Здравствуйте. Подскажите как можно в VBA связать TextBox с ячейкой, например я вызываю форму там есть TextBox1, TextBox2 когда я ввожу в них данные они бы отображались в ячейках A1,A2. Можете дать пример?