» Excel VBA (часть 2)

SAS888
спасибо за калькулятор, главное знать где начать копать, а додуматься до всего можно

Динамический двумерный массив на втором цикле видает ошибку.
Что не так?
Dim ВехиIDs() As String
d = d + 1
ReDim Preserve ВехиIDs(d, 2) As String
ВехиIDs(d, 1) = Right(T.EnterpriseText8, 3)
ВехиIDs(d, 2) = DateFormat(T.Finish, pjDate_mm_dd_yyyy)

Как на защищаемом листе позволить пользователю пользоваться Структурой (т.е. объектом Outline) - скрывать и отображать строки с помощью пиктограмм "+" и "-" ?

davidyantz
По-моему, никак, как и сортировка невозможна на защищенном листе.

Почему же сортировка невозможна? А параметр AllowSorting в методе Protect ?

davidyantz

Цитата:

AllowSorting в методе Protect

Это есть, начиная с Excel 2002.

Привет! Кто-нибудь знает как вообще искать программные синонимы встроенных функций Excel? Например Функция "ГОД()" в коде будет назваться "YEAR()". Сейчас мне нужно найти синоним функции СчитатьПустоты(). Да и вообще, может есть где-нить список соответствия?

David Kats
Англо-русское сопоставление всех функций Excel с описанием.

Vitus_Bering
Ну блин, спасибо, ВИТАС! Выручил.

Большое спасибо за помощь.

Цитата:

Подскажите, как удалить все строки (максимум 30), кроме 1й и на которой стоит курсор?

А если необходимо удалить строки кроме 1й и тех на которых отмечены ячейки (например через ctrl)?

SAS888
ещё раз огромное спасибо, век живи век учись,
если бы не подсказал где копать, сам бы не додумался не в жизнь
вот кодик который я состряпал с помощью твоей подсказки и подсказкиdneprcomp


Sub Кнопка1_Щелкнуть()
' Запускаем калькулятор
' Активизируем калькулятор
Shell "Calc.exe", vbNormalFocus

End Sub
Sub Кнопка2_Щелкнуть()
ScreenUpdating = 0
Application.ActivateMicrosoftApp 0 ' Активизируем калькулятор
SendKeys "^{c}", True
Application.Windows("Книга1").Activate ' Активизируем рабочую книгу
Range("A1").Select
ActiveSheet.Paste
Range("A1").Value = CDbl(Range("A1").Value)
Application.ActivateMicrosoftApp 0 ' Активизируем калькулятор
SendKeys "%{F4}", True ' Посылаем Alt+F4 для закрытия калькулятора
ScreenUpdating = 1
End Sub


Добавлено:
но своим калькулятором я всё же горжусь
всё таки я его забабахал, если бы раньше умел пользоваться "SendKeys", то и не стал бы мучится, а так теперь просто эту форму везде вставляю, только клавишу "ок" подстраиваю и всё

Добавлено:
dneprcomp
с переменными тоже всё отлично получилось
теперь не нужно дополнительнительных Label вводить
и всё же один вопрос повторю, он остался открытым

Цитата:

и ещё вопрос
вот например макрос
Sub Макрос1()
ActiveCell.FormulaR1C1 = "='D:\[материалы 2.xls]р'!R10C6"
ActiveCell.Value = ActiveCell.Value
End Sub
как правильно написать для ActiveCell.Value =......
чтобы не писать потом ActiveCell.Value = ActiveCell.Value

davidyantz

Цитата:

Как на защищаемом листе позволить пользователю пользоваться Структурой (т.е. объектом Outline) - скрывать и отображать строки с помощью пиктограмм "+" и "-" ?

Vitus_Bering

Цитата:

По-моему, никак, как и сортировка невозможна на защищенном листе.

Можно! Нужно воспользоваться:

EnableOutlining = True

Правда, вместе с книгой эта информация не сохраняется.

qEraser

Цитата:

А если необходимо удалить строки кроме 1й и тех на которых отмечены ячейки (например через ctrl)?

Можно так:
Sub Udalenie()
Dim MyCel As Integer
Dim nR As Integer
MyCel = Selection.Rows.Count 'Количество выделеных ячеек (строк)
nR = ActiveSheet.UsedRange.Rows.Count 'Всего строк
Selection.EntireRow.Copy
Rows(nR).Select 'Переместим выделенные строки в конец
ActiveSheet.Paste
For i = nR To 2 Step -1
Cells(i, 1).EntireRow.Delete 'Удаляем лишние
Next i
End Sub
Хотя может действительно лучше скрывать строки, чем удалять?

Вопрос:

Я создаю пункт меню в pop-up меню для ячейки:

Set cbut = Application.CommandBars("Cell").Controls.Add(before:=1, Temporary:=True)

Как мне назначить этому пункту меню картинку из ImageList ?

Так, как я делаю сейчас, не работает:

cbut.Picture.Handle = ImageList1.ListImages.Item(1).Picture.Handle

подскажите как сделать, чтоб в легенде не появлялся ряд4, і как упростить такой макрос.

Код:
Sub build_ser_rik()
Application.ScreenUpdating = False
t = UserForm1.ComboBox1.Value
name = UserForm1.ComboBox1.Value
t = CStr(t)
If t = "РАЗОМ" Then colz = 2: scalval = 230
If t = "ВХ" Then colz = 4: scalval = 110
If t = "ЛХЗ" Then colz = 5: scalval = 44
If t = "Заморозка" Then colz = 6: scalval = 0.3
If t = "ГХ" Then colz = 7: scalval = 17
If t = "БХ" Then colz = 8: scalval = 10
If t = "МП" Then colz = 9: scalval = 2
If t = "ЧГ" Then colz = 10: scalval = 6
If t = "КХ" Then colz = 11: scalval = 3
If t = "СХ" Then colz = 12: scalval = 6
If t = "РХ" Then colz = 13: scalval = 10
If t = "ЖХ" Then colz = 14: scalval = 0
If t = "КМХ" Then colz = 15: scalval = 1
If t = "ШП" Then colz = 16: scalval = 5
If t = "КЗХ" Then colz = 17: scalval = 6

xvls = Range(Cells(43, 1), Cells(54, 1)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
fakt = Range(Cells(43, colz), Cells(52, colz)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
plan = Range(Cells(58, colz), Cells(69, colz)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
fakt6 = Range(Cells(73, colz), Cells(84, colz)).Address(RowAbsolute:=False, ColumnAbsolute:=False)

Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries


'дані для графіка планової реалізації
ActiveChart.SeriesCollection(1).XValues = Worksheets("Динаміка").Range("" & (xvls) & "")
ActiveChart.SeriesCollection(1).Values = Worksheets("Динаміка").Range("" & (plan) & "")
ActiveChart.SeriesCollection(1).name = "=""Планова реалізація"""

'дані для графіка фактичної реалізації 2007
ActiveChart.SeriesCollection(2).XValues = Worksheets("Динаміка").Range("" & (xvls) & "")
ActiveChart.SeriesCollection(2).Values = Worksheets("Динаміка").Range("" & (fakt) & "")
ActiveChart.SeriesCollection(2).name = "=""Факт. реалізація 2007"""

'дані для графіка фактичної реалізації 2007

ActiveChart.SeriesCollection(3).XValues = Worksheets("Динаміка").Range("" & (xvls) & "")
ActiveChart.SeriesCollection(3).Values = Worksheets("Динаміка").Range("" & (fakt6) & "")
ActiveChart.SeriesCollection(3).name = "=""Факт. реалізація 2006"""

' ActiveChart.Location Where:=xlLocationAsNewSheet, name:= _
"Середньоденні_план_факт_" & (name) & ""
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = _
"Середньоденна реалізація в тоннах " & (name) & " 2007 р."
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "тонн"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlRight
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.FontStyle = "обычный"
.Size = 8

End With
' If ActiveChart.Legend.LegendEntries(4) = True Then
' ActiveChart.Legend.LegendEntries(4).Select
' Selection.Delete
' End If
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True

With Selection.TickLabels.Font

.FontStyle = "обычный"
Size = 8
End With
With Selection.TickLabels
.Alignment = xlCenter
.Offset = 100
.ReadingOrder = xlContext
.Orientation = xlDownward
End With

ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 11
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 11
.MarkerForegroundColorIndex = 11
.MarkerStyle = xlAutomatic
.Smooth = False
.MarkerSize = 7
.Shadow = False
End With

ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 27
.Weight = xlThick
.LineStyle = xlDash

End With
With Selection


.MarkerStyle = xlNone
.Smooth = False
.Shadow = False
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select

ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Fill.PresetGradient Style:=msoGradientHorizontal, Variant:=1, _
PresetGradientType:=msoGradientDaybreak
Selection.Fill.Visible = True
'підписи факт

'
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).ApplyDataLabels AutoText:=True

ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 8
End With
ActiveChart.ChartArea.Select


'3 графік обробка
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.ColorIndex = 26
.Weight = xlThick
'.LineStyle = xlGray50
End With
With Selection
.MarkerBackgroundColorIndex = 26
.MarkerForegroundColorIndex = 26
.MarkerStyle = xlSquare
.Smooth = False
.MarkerSize = 7
.Shadow = True
End With
'поправити 2 графік факт 2007
ActiveChart.SeriesCollection(2).Select
' ActiveChart.SeriesCollection(2).Points(5).Select
With Selection.Border
.ColorIndex = 11
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 49
.MarkerForegroundColorIndex = 49
.MarkerStyle = xlSquare
.MarkerSize = 7
.Shadow = False
End With

ActiveChart.SeriesCollection(3).ApplyDataLabels AutoText:=True
ActiveChart.SeriesCollection(3).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Size = 8
End With
'легенда
ActiveChart.Legend.Select
Selection.Left = 568
Selection.Width = 149
With Selection.Font
.Size = 8
End With

ActiveChart.PlotArea.Select
' ActiveChart.SeriesCollection(4).Delete

'шкала
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = scalval
End With

'лінія тренду
ActiveChart.SeriesCollection(2).Trendlines.Add Type:=xlLinear, name:="Лінія тренду"
'ActiveChart.Legend.Select
' ActiveChart.Legend.LegendEntries(4).Select
' Selection.Delete

ActiveSheet.Select
ActiveSheet.name = "Cередньоденна_" & (name) & ""
ActiveSheet.Move
End Sub

Кстати о англо-русском соответствии функций.
Можно пользоваться справочником (в шапке), а если его нет под рукой то записю макросов.

Здравствуйте! Есть вопрос:

Имеем форму, в которую надо заполнить и большую такую таблицу, где храниться то чем заполнять будем. Конкретно это база данных по материалам . Инвентарный номер в записях может быть одинаковым, а номер партии разный . Как сделать так чтобы при вводе в ячейку инвентарного номера была возможность выбора партии? И от этого заполнялись все остальные строки?(цена,количество). У меня пока только так получилось. Но здесь выбирает только первую встречающуюся в списке.

Private Sub Worksheet_Change(ByVal Target As Range)
make_null_os = True
Select Case Target.Column


Case 5
Set c = Worksheets(1).Range("dF1:dF5000").Find(Cells(Target.Row, Target.Column).Value, LookIn:=xlValues)
Cells(Target.Row, Target.Column + 1).Value = Cells(c.Row, c.Column + 1).Value
Cells(Target.Row, Target.Column + 2).Value = Cells(c.Row, c.Column + 3).Value
Cells(Target.Row, Target.Column + 5).Value = Cells(c.Row, c.Column + 2).Value
End Select

End Sub

FiraSaro
сходите http://www.planetaexcel.ru/tip.php там есть -
Связанные выпадающие списки
Представьте себе два выпадающих списка в ячейках, причем от того, что выбрано в первом - зависит содержимое второго.

может подойдёт?

как программно назнаить кнопке обработчик?

SERGE_BLIZNUK
Спасибо за UCase

CEMEH

Цитата:

Кстати о англо-русском соответствии функций.
Можно пользоваться справочником (в шапке), а если его нет под рукой то записю макросов.

Или стандартный файл соответствия funcs.xls. Для 2003 в "c:\Program Files\Microsoft Office\OFFICE11\1049\FUNCS.XLS"

ВОПРОС
Где в ComboBox прописать запрет введения данных, отличных от заполненных в него?
СПАСИБО

CEMEH
ComboBox1.MatchRequired=True

ComboBox1.MatchEntry = fmMatchEntryFirstLetter
ComboBox1.MatchEntry = fmMatchEntryNone
ComboBox1.MatchEntry = fmMatchEntryComplete

dneprcomp
А не проще ли будет сделать только выбор значений из раскрывающегося списка?
ComboBox1.Style = fmStyleDropDownList

AndVGri

Цитата:

А не проще ли будет сделать только выбор значений из раскрывающегося списка?

Такое решение не соответствует запросу CEMEH А вот что ему подходит больше, пусть сам решает.

Часто ручной ввод оказывается быстрее и удобнее для юзера. Кроме того, можно в списке показывать одно, а разрешить набирать другое. Как пример, двухколоночный список Описание/Код. Знающему юзеру быстрее набрать код. Не знающему дается выбор из листа по Описанию. Но в текстовое поле все равно попадает Код.

dneprcomp
В коде я записал все четыре условия но...
КомбоБокс используется для выбора фамилий из списка (строк очень много) И если я набираю в поле КомбоБокса "И" то подставляются все возможные варианты начинающиеся на "И", если я ввожу "Ив" то все варианты с "Ив". После выполнения всех четырех пунктов "Ив" я ввести не могу. Либо "И", либо "В", а "Ив" только из раскрывающегося списка. Я не силен в англицком, поэтому многое для меня темный лес.
Первое, что на ум приходит, это цикл с проверкой КомбоБокс на соответствие6
Z=false
for x=1 to 1000
if combobox1=range("A" & X) then Z=true
Next x
If Z=false then msgbox "фамилии нет в списке"
Но такой вариант громоздкий и долгий

и еще ВОПРОС
Как в range("A1") кроме ссылки на ячейку добавить еще и ссылку на лист.

СПАСИБО

CEMEH

Цитата:

В коде я записал все четыре условия но...

Нельзя использовать все условия сразу. И не обязательно устанавливать параметры контрола в коде. Можно и в свойствах контрола их установить. Если не собираешься менять настройки динамически, то настройка через свойства наиболее оптимальна.
ComboBox1.MatchRequired=True обязательна

Одна из трех на выбор, а не все сразу.
ComboBox1.MatchEntry = fmMatchEntryFirstLetter совпадение по первой букве(можно вносить только соответствующие знаки)
ComboBox1.MatchEntry = fmMatchEntryNone без совпадения(можно печатать любые знаки)
ComboBox1.MatchEntry = fmMatchEntryComplete совпадение по полной строке(долны совпасть все знаки в строке)

Цитата:

Как в range("A1") кроме ссылки на ячейку добавить еще и ссылку на лист.

Лист чего? Если контрол, то =ComboBox1.Text
А если лист книги, то =Sheet3!B1
И что значит "кроме"? Не может быть двух ссылок одновременно.

Цитата:

Я не силен в англицком, поэтому многое для меня темный лес.

Или ищи русский хелп(что является полурешением), или учи язык(что предпочтительнее). Третьего не дано. Без знания английского так и будешь путаться в простейшем.

Кто подскажет? Можно ли при помощи VBA Excel перехватить данные по COM-порту? Если можно, то как это сделать?

dneprcomp

Цитата:

Лист чего?

СПАСИБО
Да, Sheet3!B1, именно то, что нужно. теперь для полученя значения ячейки я пишу A=range("лист1!A1"). А как записать А=range(книгa_на жестком_диске, лист, ячейка)? Особенно, если не указан прямой путь к файлу, а нужен файл, находящийся в каталоге вместе с исходной книгой, в которой записан макрос. Т е если я перенесу папку с файлами в другое место или на другой компьютер (изменю путь к папке) то макрос все равно будет работать корректно.

CEMEH

Цитата:

нужен файл, находящийся в каталоге вместе с исходной книгой, в которой записан макрос

Application.Path & книгa_на жестком_диске