» Excel VBA (часть 2)

dneprcomp
Спасибо.

Добавлено:
CEMEH

Цитата:

Каким образом в коде VBA выделить, скажем 3,4,5,6 и 7

Установи свойство ListBox:
1-fmMultiSelectMulti
1-fmListStyleOption

aks_sv
Нет, не получается. На этапе разработки галки в ListBox ставлю, а при запуске формы (F5) галок нет.

CEMEH
Вышли файл

может кто-нибудь спасёт, вопрос такой, если LsitBox уже заполнен, а в нём 5 колонок и например нужно вытащить в выбранной строке число из 5-й колонки. как можно такое сделать, не прибегая к дополнительным вычислениям в ячейках, с которых LsitBox грузится.



кстати, если кому надо, то вот код который убирает крестик с формы
вставляется ...., да короче создаём форму, сразу в неё вставляем, а потом можно дальше чудить
Private Declare Function FindWindow _
Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long


Private Sub UserForm_Initialize()
Dim ihWnd As Long, iStyle As Long

ihWnd = FindWindow(vbNullString, Me.Caption)
iStyle = GetWindowLong(ihWnd, -16&)
SetWindowLong ihWnd, -16&, iStyle And Not &H80000
End Sub

Добавлено:
и ещё вопрос назрел, а вот если в ListBox слово не помещается, оно естественно обрезается, а можно ли сделать так чтобы то, на чём находится курсор мышки увеличивалось до полного размера слова, ну как в сводной таблице, например

denisdenmm

Цитата:

может кто-нибудь спасёт, вопрос такой, если LsitBox уже заполнен, а в нём 5 колонок и например нужно вытащить в выбранной строке число из 5-й колонки. как можно такое сделать, не прибегая к дополнительным вычислениям в ячейках, с которых LsitBox грузится.

Что-нибудь вроде этого? Пример


Добавлено:

Цитата:

Другой вопрос: как вставить в несколько не смежных ячеек выбранную дату на форме "календарь"?

Снимаю вопрос

Код: Private Sub CmdOK_Click()
Selection = Calendar1.Value
Unload Me
End Sub

Народ. Все еще нужна помощь с автофильтрами по вопросу на стр.52.

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

а вот вторая часть вопроса, поискал в нете, пока ответа не нашёл,

как бы сделать так, чтобы при наведении курсора мышки на обрезанное в листбоксе слово оно высвечивалось полностью, то есть как в сводной таблице

я кое что находил, но почему-то не прокатило, выдавало ошибку


ну чтобы не делать листбокс огромным, а например курсор навёл на какую-либо строку и видно что там написано полностью
ПОМОГИТЕ КТО ЧЕМ СМОЖЕТ!!!!!!!!!!!!!!! SOS!!!!!!!!!!!!!!!

denisdenmm
Вот здесь что-то есть на эту тему. Если найдешь решение, дай знать.

Для поиска и вставки значений с добавлением к значениям формул, применяю это:

Range("AJ63").Select
x = Application.WorksheetFunction.VLookup("Rent", Workbooks("BDF.xls").Worksheets("expenses").Range("A45:BB200"), 11, False)
ActiveCell.Formula = "=" & x & "*AJ51"

но есть пара вопрос:
если искомое значение ноль, то сразу выдается сообщение об ошибке в строке:
ActiveCell.Formula = "=" & x & "*AJ51"
-как этого избежать?

Подскажите, пожалуйста.

ol7ca
Ошибка возникает не когда х=0, а когда IsEmpty(x)=True.

Oyger

Цитата:

ol7ca
Ошибка возникает не когда х=0, а когда IsEmpty(x)=True.

Это хорошо. Но я все равно не пойму что мне в этом случае делать.

ol7ca
Поставь проверку на IsEmpty(x)=True. Т.е. проверяй перед выполнением записи в ячейку, присвоено ли значение переменной Х.

Здравствуйте, уважаемые! имею следущую ситуацию:
Сделал по заказу столовой файлик меню-раскладка, имеем:
строки(период)/столбцы(продукты) манка/гречка/мясо/куры/и тд.. всего 65 наименований
завтрак
обед
ужин
-----
итого

Список продуктов на листе постоянен, но не все они используются в меню текущего дня.
Для уменьшения величины распечатываемой "простыни" написал макрос скрывающий столбцы в которых значение ячейки i32(итого продукта) = 0. На пальцах все получается, но вот корректно реализовать к сожалению не могу...

Sub ColumnHidden()
Dim i As Long, x As Long
Application.ScreenUpdating = False
[F1].Select
x = ActiveCell.Offset(255, 0).End(xlUp).Column
For i = x To 1 Step -1
If Cells(i, 32) <= 0 Then Cells(i, 32).EntireColumn.Hidden
Next i
Application.ScreenUpdating = True
End Sub

вылетает в дебагере в ошибку 1004:
метод Hidden из класа Range завершен неверно...

подскажите, пожалуйста, где моя ошибка

Gluzer
Так, давай попорядку.

Цитата:

столбцы(продукты) манка/гречка/мясо/куры/и тд..

Цитата:

Для уменьшения величины распечатываемой "простыни" написал макрос скрывающий столбцы в которых значение ячейки i32(итого продукта) = 0.

Ты, похоже, путаешь координаты: сначало идет номер строки, а потом - номер столбца
Т.к.
Цитата:

Список продуктов на листе постоянен

То

Цитата:

F1.Select
x = ActiveCell.Offset(255, 0).End(xlUp).Column

Замени просто на: x = Cells(1, 256).End(xlToLeft).Column
Это присвоит переменной Х номер последнего столбца в котором заполнена ячейка в первой строке.
А твой код присвоит Х номер столбца активированной ячейки - ячейки F1.

Цитата:

If Cells(i, 32) <= 0 Then Cells(i, 32).EntireColumn.Hidden

Замени на: If Cells(32, i).Value <= 0 Then Columns(i).Hidden = True

Oyger

Цитата:

Народ. Все еще нужна помощь с автофильтрами по вопросу на стр.52.

Selection.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Begin_date), Operator:=xlAnd, Criteria2:="<=" & CDbl(End_Date)

Добавлено
Oyger
:Rolling eyes:

Gluzer
А еще лучше замени весь код на:
Sub ColumnHidden()
Dim i As Byte 'Byte хоть и потдерживает значения до 255, но у Тебя все равно заполненых столбцов меньше - экономь память /смеется/
Application.ScreenUpdating = False
For i = 1 To Cells(1, 256).End(xlToLeft).Column
If Cells(32, i).Value = 0 Then Columns(i).Hidden = True
Next i
Application.ScreenUpdating = True
End Sub


Добавлено:
Olive77
В какое место Тебя расцеловать, дорогой? /смеется/
Совсем забыл, что Даты в Excel, это только визуально представление. А записываются они в памяти как числа.
Thank You Very Much!

Oyger

Спасибо.

Прошу прощения за глупые вопросы - я новичек в VBA.
Можно ли еще подсказку - куда это вставить в моем примере.
Я попробывал - не получилось - выдает ошибку -(

Range("AJ54").Select
x = Application.WorksheetFunction.VLookup("TOTAL", Workbooks("BM.xls").Worksheets("BM").Range("A1:BK200"), 28, False)
IsEmpty(x) = True
ActiveCell.Formula = "=" & x & "*AJ52"

Oyger
спасибо, все почти как надо
вот теперь думаю как лучше сделать следующий этап:
/столбцы(продукты) Говядина    итого(пром.итог)    Птица    итого(пром.итог)
То есть после каждого из продуктов идет столбец промежуточного итога, но в 32 строке этого столбца даных нет(в этой ячейке всегда пусто).
задача: Столбец промежуточного итога надо скрывать только в том случае если скрыт основной столбец(в текущем коде скрываются все ячейки с нерезультирующей ячейкой i32)/ Попытался прикрутить в цикл i параметр step 2, но что то ничего путного не вышло...

Gluzer
У Тебя в строке 32 в "продукте" стоит сумма формулой, а в подитоге всегда пусто?
Тогда вместо

Цитата:

If Cells(32, i).Value = 0 Then Columns(i).Hidden = True

Пиши:
If Cells(32, i).Value = 0 and IsEmpty(Cells(32, i).Value) = False Then Columns(i).Hidden = True

Добавлено:
ol7ca
Вместо

Цитата:

IsEmpty(x) = True
ActiveCell.Formula = "=" & x & "*AJ52"

If IsEmpty(x) = False Then ActiveCell.Formula = "=" & x & "*AJ52" 'Если переменная Х не "пустая", то пишем формулу.

Oyger

Заработало. Cпасибо.

Oyger
спасибо, но не отработало как надо
посмотри примерчик
File: Книга1.rar
DownloadLink: http://rapidshare.com/files/66533468/list1.rar

Gluzer
Держи. Сделано все "под Тебя".
Sub ColumnHidden()
Dim i As Byte
Application.ScreenUpdating = False
For i = 5 To Cells(5, 256).End(xlToLeft).Column - 1 Step 2
If Cells(32, i).Value = 0 Then
Columns(i).Hidden = True
Columns(i + 1).Hidden = True
End If
Next
'Скрываем пустые строчки до "Итого"
For i = 6 To Columns("C:C").Find(What:="Итого", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row - 1
If Cells(i, 3).Value = 0 Then Rows(i).Hidden = True
Next
Application.ScreenUpdating = True
End Sub

Oyger
респект и уважуха!!! сто грамм и огурчик с меня...

Я ТУТ ОПЯТЬ НАРИСОВАЛСЯ СО СВОЕЙ ПРОБЛЕМОЙ ВЫВОДА ПОЛНОЙ СТРОКИ ЕСЛИ ОНА ОБРЕЗАНА В ЛИСТБОКСЕ, ВОТ ЧТО НАШЁЛ, НО ПО ВСЯКОМУ ПЫТАЛСЯ ПОРАБОТАТЬ С ЭТИМ, ВЫДАЁТ ОШИБКИ, ТО ТАМ ТО СЯМ
В ИТОГЕ ПОСЛЕ МОИХ МЫТАРСТВ НИЧЕГО НЕ ПОЛУЧИЛОСЬ, МОЖЕТ БЫТЬ КТО-НИБУДЬ ТОЖЕ ПОПРОБУЕТ ПОВОЗИТСЯ


Нюанс 2. Создание расширения для ListBox: Свойство - ?Вывод в виде подсказки ToolTyp длинных элементов спискаЋ

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Const LB_ITEMFROMPOINT = &H1A9 'константа API-функции

Private Const m_def_ToolTypLong = True 'константа контрола

Dim m_ToolTypLong As Boolean 'переменная контрола


'Масштабирование ListBox - необязательно. Здесь показывается с чисто эстетических позиций

Private Sub UserControl_Resize()
List1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

'Данная функция здесь показана для удобства пользователя (проведение тестирования)

Public Sub AddItem(ByVal Item As String, Optional ByVal Index As Variant)
List1.AddItem Item, Index
End Sub

Private Sub UserControl_InitProperties()
m_ToolTypLong = m_def_ToolTypLong
End Sub

'данное свойство руководит выводом или невыводом подсказки

Public Property Get ToolTypLong() As Boolean
ToolTypLong = m_ToolTypLong
End Property

Public Property Let ToolTypLong(ByVal New_ToolTypLong As Boolean)
m_ToolTypLong = New_ToolTypLong
PropertyChanged "ToolTypLong"
End Property

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lXPoint As Long, lYPoint As Long, lIndex As Long

'если не нажата никакая клавиша мыши и свойство ToolTypLong установлено в True

If (Button = 0) And (m_ToolTypLong = True) Then
'перевод в пикселы

lXPoint = CLng(X / Screen.TwipsPerPixelX)
lYPoint = CLng(Y / Screen.TwipsPerPixelY)

With List1
'выбирает индекс списка, в зависимости от позиции курсора

lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, _
ByVal ((lYPoint * 65536) + lYPoint))
'если курсор вне записей списка

If (lIndex >= 0) And (lIndex <= .ListCount) Then
.ToolTipText = .List(lIndex)
Else
.ToolTipText = vbNullString
End If
End With
End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ToolTypLong = PropBag.ReadProperty("ToolTypLong", m_def_ToolTypLong)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ToolTypLong", m_ToolTypLong, m_def_ToolTypLong)
End Sub

Подскажите, плз, как можно одним макросом запустить другие пять?
Дайте, пжл, пример скрипта.
Спасибо.

Добавлено:
Вопрос к модератору:
Можно ли скопировать этот форум в текстовой файл для облегчения поиска вопросов, которые уже обсуждались?
Мне кажется это облегчит жизнь и тем, кто ищет и тем, кто отвечает на вопрос в сотый раз.

ol7ca
Весь форум не уверен А вот для темы: обрати внимание на

dneprcomp

Это тоже поможет. Спасибо!

ol7ca

Цитата:

Подскажите, плз, как можно одним макросом запустить другие пять?

Смотри Application.Run

ВОБЩЕМ Я СВОЙ ВОПРОС СНИМАЮ ПОЛНОСТЬЮ

Цитата:

Я ТУТ ОПЯТЬ НАРИСОВАЛСЯ СО СВОЕЙ ПРОБЛЕМОЙ ВЫВОДА ПОЛНОЙ СТРОКИ ЕСЛИ ОНА ОБРЕЗАНА В ЛИСТБОКСЕ, ВОТ ЧТО НАШЁЛ, НО ПО ВСЯКОМУ ПЫТАЛСЯ ПОРАБОТАТЬ С ЭТИМ, ВЫДАЁТ ОШИБКИ, ТО ТАМ ТО СЯМ
В ИТОГЕ ПОСЛЕ МОИХ МЫТАРСТВ НИЧЕГО НЕ ПОЛУЧИЛОСЬ, МОЖЕТ БЫТЬ КТО-НИБУДЬ ТОЖЕ ПОПРОБУЕТ ПОВОЗИТСЯ

НЕМНОГО ПРИЛОЖИЛ МОЗГОВ И ВОТ ЧТО ПОЛУЧИЛОСЬ:
(МЕНЯ ЭТО ПОЛНОСТЬЮ УСТРАИВАЕТ)

Private Sub ListBox1_Change()
Dim EmpFound As Range
LastRow = Range("A1:C10").End(xlUp).Row
With Range("A10:C" & LastRow)
Set EmpFound = .Find(ListBox1.Value)
With EmpFound
ComboBox2.Value = .Offset(, 1).Value
ComboBox2.Width = Round(ComboBox2.Width + 10)
ComboBox3.Value = .Offset(, 2).Value
ComboBox3.Width = Round(ComboBox3.Width + 10)
End With
End With
Dim i As Variant
ComboBox1.Value = ListBox1.Value
ComboBox1.Width = Round(ComboBox1.Width + 10)
i = ComboBox1.Width & ";" & ComboBox2.Width & ";" & ComboBox3.Width
ListBox1.ColumnWidths = (i)
ListBox1.Width = 3 + ComboBox1.Width + ComboBox2.Width + ComboBox3.Width
ListBox1.ControlTipText = ListBox1.Value
End Sub
Private Sub UserForm_Initialize()
ComboBox1.Visible = False
ComboBox1.AutoSize = True
ComboBox2.Visible = False
ComboBox2.AutoSize = True
ComboBox3.Visible = False
ComboBox3.AutoSize = True
LastRow = Range("A1:C10").End(xlUp).Row
ListBox1.RowSource = "A10:C" & LastRow
End Sub

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

Добавлено:
так с авто запуском разобрался

Код:
Private Sub Auto_Open()
MsgBox "It's work", vbInformation
End Sub