» Excel VBA (часть 2)

SAS888
Alexikit
Друзья, спасибо огромное. Все просто супер!!!

Как быстро вводить дату и время в виде простых чисел (110507 вместо 11.05.2007 и 0635 вместо 6:35) в заданные ячейки листа?

Вот нашел ответ, но почемуто не всегда работает, не поиму что не так. Даите пожалуиста ликбез. Спасибо

Если Вам часто приходится вводить даты и время в ячейки, то Вам должна понравиться идея писать их сокращенно, без точек-дробей-двоеточий - просто как число. Чтобы (в заданном диапазоне ячеек листа) 250699 автоматически превращалось в 25.06.1999, а 1125 в 11:25.

Для этого щелкните по ярлычку листа, куда будут вводиться даты и время и выберите Исходный текст (Source Code). В открывшееся окно редактора Visual Basic скопируйте и вставьте следующий код:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
Dim dDate As Date

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
With Target
StrVal = Format(.Text, "000000")
If IsNumeric(StrVal) And Len(StrVal) = 6 Then
Application.EnableEvents = False
dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
.NumberFormat = "dd/mm/yyyy"
.Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))
End If
End With
End If

If Not Intersect(Target, Range("B2:B10")) Is Nothing Then
With Target
vVal = Format(.Value, "0000")
If IsNumeric(vVal) And Len(vVal) = 4 Then
Application.EnableEvents = False
.Value = Left(vVal, 2) & ":" & Right(vVal, 2)
.NumberFormat = "[h]:mm"
End If
End With
End If
Application.EnableEvents = True

End Sub

virginijus
1. Код обрабатывает только событие "своего" рабочего листа;
2. Описанными способами обрабатываются изменения ячеек A2:A10 (дата) и B2:B10 (время).

Здравствуйте!
Подскажите, пожалуйста, как получить доступ к конкретному символу (по его порядковому номеру) в ячейке на VisualBasic?

ZHirnovMax

Dim x$, n%
ActiveCell.Font.ColorIndex = xlAutomatic
n% = InputBox("Введите НОМЕР символа в активной ячейке")
With ActiveCell
.Characters(Start:=n%, Length:=1).Font.ColorIndex = 3
x$ = Mid$(.Text, n%, 1)
End With
MsgBox "В содержимом активной ячейки под номером " & n% _
& " находится знак " & """" & x$ & """" & Chr(13) & "(выделен красным цветом)."

Помогите плз.! Хочу открыть два Exel,евских документа сразу, а он открывает их в одном окне!!!! Как исправить ситуацию. Переключаться внутри окна с дока на док соверщенно невыносимо!!!!! Отпишитись плиз.
Уточняю суть вопроса на примере документов Word, два разных документа открываются в разных окнах, также должно быть и в Exel. Сам такое видел на другом компе, но у себя применить не знаю как!

Спасибо, vlth и ecolesnicov.

Еще вопрос созрел. Как идеологически правильно (хы), выводить на форме табличные данные?
Конкретно.
Есть такая форма
http://img12.yfrog.com/i/93962751.gif/

Проблема в том, что ингредиентов может быть 5, а может и 20. Значит, нужно динамически управлять размером формы, добавлять и удалять комбо- и текстбоксы. Уф, как-то муторно выходит.

pucca5005
Добавлять-удалять не обязательно: можно сконструировать форму с максимальным кол-вом элементов (размеры формы при этом будут максимальными), а при работе - управлять её размерами и видимостью комбобоксов-техтбоксов и пр.

Для обхода в цикле всех элементов формы нужно заранее продумать их имена и доп. свойства (например, св-во "Tag"), чтобы к ним было удобнее обращаться (например, txtQuantity1, txtQuantity2, ... - группа техтбоксов "Количество"). Одинаковые по функционалу элементы, также для удобства обращения к ним, лучше объединять в одном фрейме. Например:


Код: With frmФорма
For Each Element In .fraФрейм1.Controls
If Element.Name = "txtQuantity" & Element.Tag Then
'If Element.Name Like "txt*" Then
'и т.п. - вариантов здесь много
Element.Visible = True
...

pucca5005
попробуй грид. при желании можно и число колонок динамически задавать

Можно ли как нибудь сделать чтобы название листа или сам лист был ссылкой на другой документ? Тоесть если мы открываем лист в одном документе он показывает на эотм листе информацию из другого листа другого документа?
И как можно сделать чтобы на одном листе было несколько автофильтров, а то по умолчанию возможно вставлять только один.

подскажите какой код сделать на кнопочку, чтобы вызвать функцию "Вставка обьекта из файла" --- нужно, чтобы народ не лазил "Вставка-Обьект-Из-файла"


все облази не могу найти.

Зачем же где-то что-то искать, когда есть макрорекордер? - код, им записанный, нужно только расширить вызовом какого-нить диалогового окна выбора файла для вставки.

спасибо. нашел как сделать, но столкнулся с еще одной проблемкой
написал шаблон в excel 2003 с использованием маршрутов exchange , а в 2007 его оказывается убрали.
ну когда выбираешь файл- отправить по маршруту и т.д.
сделал кнопочку - думал прокатит, а в 2007 оказывается вообще убрали
даже как функцию. может есть варианты какие или плагин например, можете посоветовать
что нибудь. вот пример кнопки для отправки

ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
.Delivery = xlOneAfterAnother
.ReturnWhenDone = True
.TrackStatus = True
End With
ActiveWorkbook.Route

Добрый день.
Как можно изменить все диаграммы находяшиеся на лист1?

этот код работает только если каждая диаграмма на отдельном листе, но мне нужно чтоб они были на лист1.

Sub nb()

Dim oChart As Chart
Dim nNach As Integer
Dim nKon As Integer

nNach = 1
nKon = 2501

For Each oChart In Charts

oChart.SeriesCollection(1).XValues = Range(Cells(nNach, 1), Cells(nKon, 1))
oChart.SeriesCollection(2).XValues = Range(Cells(nNach, 1), Cells(nKon, 1))
oChart.SeriesCollection(1).Values = Range(Cells(nNach, 2), Cells(nKon, 2))
oChart.SeriesCollection(2).Values = Range(Cells(nNach, 3), Cells(nKon, 3))

Next

End Sub

Ombilic

Цитата:

Хочу открыть два Exel,евских документа сразу, а он открывает их в одном окне!

Вы задали вопрос не в той теме, здесь обсуждаются вопросы только по Excel VBA.
Но тем не менее попробую посоветовать после открытия первого файла открыть ещё одно пустое окно Excel (Главное меню/Все программы...) и из этого окна через меню Файл - Открыть выбрать второй файл. Таким образом файлы будут открыты в разных окнах.

Добрый вечер.
Не знаю тут или не тут такой вопрос задать.

В ячейке значения, буквенные и цифровые около 80 знаков.
Можно ли как ни будь сделать что бы автоматически убрались значения до 36 и после 49, то есть остаться должны только промежуток между 36 и 49?

1. Разместите функцию в, скажем, стандартном модуле VBA Вашей рабочей книги.
2. Выберите её в списке функций рабочего листа в категории "Определённые пользователем".
3. Пользуйтесь как обычной функцией.

Function fnLRDel(oCell As Range)
fnLRDel = Mid$(oCell.Text, 36, 14)
End Function

Удачи.

vlth
Не когда этого не делал, сейчас буду пробовать.
Спасибо огромное.

Может кто подскажет как избавится от ошибки

Worksheets("list").Activate
Dim s As Variant
s = InputBox("simvol!")
Dim c As Range
Set c = Range("B1:B65536").Find(s & "*", , , xlWhole)
If Not c Is Nothing Then c.Select

В последней строке выдает ошибку "метод select из класса range завершен не верно"

Не получается не чего, но скорей всего я что-то делаю не так ибо вобще в этом не бум бум

siriusall
код вставь в VB редактор и
забей функцию в соседнюю ячейку

никогда, ничего ... -пишется вместе

visual73
Спасибо большое, за совет и грамматическое напутствие.
Все равно ничего не получается(((=

Добавлено:
Может есть у кого секундочка в аське, что бы мне пошагово, был бы очень благодарен

Добавлено:
vlth
visual73
Парни, СПАСИБО ВАМ огромное все получилось, СПАСИБО еще раз

siriusall
На самом деле эта функция VBA как таковая не нужна: она - всего лишь пример создания пользовательской функции, поскольку является частным случаем
ПСТР(текст; начальная_позиция;число_знаков)

=ПСТР(A1;36;14)

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

Я так сказать моментом воспользуюсь,
000652 как сделать что бы после 6 стояла запитая? 0006,52
Есть ли на этот случай чудо функция?

P.S. Excel это гранит науки который надо грызть=)

=ПОДСТАВИТЬ(A1;6;"6,")

Добавлено:
=ЛЕВСИМВ(A1;4)&","&ПРАВСИМВ(A1;2)

Добавлено:
TimoXa_Skot

Цитата:

Может кто подскажет как избавится от ошибки

Синтаксических ошибок в приведённом коде нет. Для нахождения источника проблем поробуй варианты его запуска:
1. На других машинах
2. Выдели этот фрагмент из контекста содержащей его процедуры (если, конечно, таковое имеет место быть ))))
и т.д. и т.п.

vlth
По первой не получилось, по второй все гуд.

Ты гений, СПАСИБО ОГРОМНОЕ. Ты меня спас.

Копирую диапазон ячеек с помощью ActiveSheet.Paste

ThisWorkbook.Activate
Sheets("АКТ").Select
Range("A1:J8").Select
Selection.Copy
Workbooks(outfile).Activate
ActiveSheet.Paste

Выдает попап "Проверка совместимости" Возможно будут утеряны некоторые параметры форматирования....

Можно нажать кнопку "Продолжить", но это крутиться в цикле для 20-30 файлов, не хочеться жать 30 раз кнопку "Продолжить"

Как отключить данную проверку? Желательно из макроса.
Если отключить нельзя, как заставить Excel принимать дефолтные значения данной формы?
(действие "продолжить" - это действие по умолчанию)

Спасибо.

siriusall

Цитата:

000652 как сделать что бы после 6 стояла запитая? 0006,52

Цитата:

По первой не получилось

Первая функция подставляет в строку "6," вместо "6" независимо от местоположения шестёрки(ок) в тексте, содержащемся в ячейке, а также независимо от длины текста. Т.е., если в исходной строке будет 100 знаков, из которых 5 шестёрок, то будет возвращена строка из 105 знаков (то, что было + 5 запятых)

Вторая - заменяет текст след. образом: 4 знака справа + запятая + 2 знака слева, т.е. возвращает строку, содержащую как минимум 1 знак - запятую (если исходная строка пустая) и как максимум - 7 знаков, один из которых - запятая.

Обе функции соответствуют условию поставленной задачи

Добавлено:
LukaBtbb
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("АКТ").Range("A1:J8").Copy _
Workbooks(outfile).ActiveSheet.Range("A1")

vlth
А, вот как, я о нечто подобном подумал, просто естественно у меня там цифры другие по этому и не сработало, спасибо, за объяснения, это действительно очень полезно, теперь буду знать.
Спасибо большое.
Спасибо за то что не только помогаешь, ну и даешь пояснения, действительно очень ценно.

Добрый день, помогите чайнику. Нашел на 32 странице форума макрос для удаления нулевых значений (у меня не работает).
Dim start_cell As Range
Set start_cell = Worksheets("Total_E").Cells(2, "D")
With Worksheets("Total_E")
Set in_r = Range(start_cell, start_cell.End(xlDown))
End With
index = start_cell.End(xlDown).Row - 1
While index > 1
If in_r.Cells(index, 1).Value = 0 Then
With Worksheets("Total_E")
.Rows(index + 1).Delete Shift:=xlUp
End With
End If
index = index - 1
Wend
Может это и не тот, но Очень нужен макрос для удаления строк в таблице, если значение столбца (например № 12) в данной строке равно нулю. Помогите, плиз.