» Excel VBA (часть 3)

Gyura
можно пожалуйста на примере?

Drazhar ,
Вот в этом и дело, что у меня ничего нормального не получилось. То ли все одинаковые результаты получились, то ли ничего и не получилось, а перенос в двухмерный массив вообще и не удался
Сейчас у меня нет кода, но на форме несколько OptionButton, и выбирая 1, а потом нажимая OK, должен происходить расчёт формулы, а потом заполнение 2 столбца результатами "y"и соответствующими "x".

Gyura
[Да я не об этом. то есть надо чтобы в первом столбце лежали значения X а во втором значения Y и все?

Добавлено:
Private Sub OKButton_Click()
dim i as double
j=1
for i=1 to 100 step 0,5
sheets("Лист1").cells(j,1).value=i
sheets("Лист1").cells(j,2).value=funct(i)
j=j+1
next i
end sub
function funct(x as double) as double
funct=x^2+2*x+1
end function

Drazhar,
Спасибо большое!

Доброе время суток.
Возникла следующая проблема. Есть лист. На листе несколько комбиков и кнопок. При работе на одном определенном компьютере при простом клике на них, начинают ползти шрифты и размеры. Никаких обработчиков событий связанных с ними не стоит.
Масштаб 100%. Отдебажить изменение невозможно(оно происходит не из VBA)
Хоть примерно, в какую сторону копать?
Заранее спасибо

Drazhar, может поступить радикально - все активные элементы убрать в тулбарчик?

ZlydenGL
в смысле в тулбарчик?

Drazhar, создаешь для конкретной книги дополнительный тулбарчик, например в событие OnActivate, а в событие OnDeactivate соответственно вставляешь код скрытия/удаления этого самого тулбарчика. Я сейчас все свои скрипты переписываю под этот подход - намного удобнее ИМХО, чем располагать активные элементы прямо на ячейках рабочей книги!

Получается следующая штука:

Код: Private Sub Workbook_Activate()
Dim CBar As CommandBar, LaunchImport As CommandBarButton
Set CBar = Application.CommandBars.Add("My Toolbar", msoBarTop)
CBar.Enabled = True
CBar.Visible = True
Set LaunchImport = CBar.Controls.Add(msoControlButton)
LaunchImport.Style = msoButtonIconAndCaption
LaunchImport.FaceId = 8
LaunchImport.Caption = "My Caption"
LaunchImport.OnAction = "LaunchModule"
End Sub

Private Sub Workbook_Deactivate()
Dim CBar As CommandBar
For Each CBar In Application.CommandBars
If CBar.Name = "My Toolbar" Then CBar.Delete
Next CBar
End Sub

Здравствуйте
Мне кажется что следующий вопрос уже здесь стоял, покрайней мере я уже где-то читал об этом. Если так, то укажите страницу, пожалуйста. Если кто помнит?
Вопрос: Нужно что бы при вводе данных в "InputBox" вместо цыфр и букв в строке ввода к примеру "abcd123" высвечивальсь бы "*******".

ferias
У textbox Есть свойство passwordchar
У inputbox Нативно такой возможности по-моему нет.

Drazhar
Это то, что нужно. Спасибо.

На VBA нужно вытянуть картинку из Picture1 на форме и разместить ее в массив.
Код заимствован из инета. Вызываю функцию так:
GetImage Ary, GetDC(UserForm1.Picture1.Picture.Handle), UserForm1.Picture1.Picture.Handle
в итоге - не работает. ((

Прошу руку помощи! Помогите решить задачу!


{Module1

Public Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long) As Long

Public Declare Function GetDiBits Lib "gdi32" Alias "GetDIBits" _
(ByVal hdc As Long, _
ByVal hBitmap As Long, _
ByVal nStartScan As Long, ByVal nNumScans As Long, _
ByRef lpBits As Any, lpBI As BITMAPINFO, _
ByVal wUsage As Long) As Long

Public Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, _
ByVal hObject As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long


Type RGBQUAD
b As Byte
g As Byte
r As Byte
Reserved As Byte
End Type

Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Public Const DIB_RGB_COLORS = 0 ' color table in RGBs


Public Function GetImage(ByRef Ary() As RGBQUAD, hdc As Long, hBMP As Long)
Dim BMI As BITMAPINFO
Dim w As Long, h As Long

With BMI.bmiHeader
.biSize = Len(BMI.bmiHeader)
End With

GetDiBits hdc, hBMP, 0, 1, ByVal 0&, BMI, DIB_RGB_COLORS

With BMI.bmiHeader
w = .biWidth
h = Abs(.biHeight)
.biBitCount = 32
.biHeight = -h
End With

If w <= 0 Or h <= 0 Then
Err.Raise 11111, "GetImage", "Failed."
End If

ReDim Ary(0 To w - 1, 0 To h - 1)
GetDiBits hdc, hBMP, 0, h, Ary(0, 0), BMI, DIB_RGB_COLORS
End Function

}

{ module2
Option Explicit

Public Declare Function GetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, _
ByVal yPoint As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

}


вызываю так:

Dim Ary() As RGBQUAD
GetImage Ary, GetDC(UserForm1.Picture1.Picture.Handle), UserForm1.Picture1.Picture.Handle

Люди подскажите, у меня уже крышу сносит.
Есть макрос, через который подгружается экселевский файл, необходимая ячейка ищется по содержанию, и от нее уже пляшет вся обработка. Вот строка поиска:
Set f = w.Find("Сметная прибыль", , xlValues, xlWhole).Offset(1, 1)

Мне нужно переделать поиск на другое содержание, но вхождение частичное, а не полное.
Получается так:
Set f = w.Find("Итого прямые затраты по", , xlValues, xlPart).Offset(0, 1)

Но после смены этой строчки, макрос уходит как бы в цикл, курсор кружочком моргает и все. Причем самый прикол, что глюк вылазит после смены .Offset(1, 1) на .Offset(0, 1), если этот параметр не менять, то остальные изменеия в строке макрос принимает.

Но больше меня поразила пошаговая отработка макроса.
Макрос работает так: Запрос файла-выбранный файл копируется в текущую книгу отдельным листом-поиск ячейки-обработка.

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

Excel 2007


А поиск по частичному вхождению xlPart медленнее чем по полному xlWhole?


Вобчем перекурил я, взял старый вариант, внес по новому изменения, ..... и все пошло!

Что был за глюк я так и не понял.

Цитата:

поиск по частичному вхождению xlPart медленнее чем по полному xlWhole?

C минимальной разницей ИМХО - все-таки поиск идет нативными средствами приложения.


Цитата:

Макрос работает так

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

Добавлено:
Если цикл "рисуется" только из-за оффсета, то можно побороться при помощи ломика и фомки


Код: Set f = w.Find("Итого прямые затраты по", , xlValues, xlPart).Offset(1, 1)
Set f = w.cells(f.Row-1, f.Column)

Цитата:

А можешь весь код макроса привести, только под спойлером?

Уже нет переписал.

Ошибка при компиляции макроса?
Доброго времени суток... Помогите решить проблему. Стоит Office 2000, есть рабочие файлы Excel (хранятся на серваке Windows Server 2003) в которые вбиваются данные, после этого файлы формируются и т.д. До переустановок WindowsXP все работало Ок и никаких проблем невозникало. Сейчас же при открытии рабочего файла появляется одна ошибка (см. рис.1,2). Потом когда в сформированом файле нажимаем на ячейку отправить (раньше сразу открывалось сформированное письмо с вложением в The Bat, в котором нужно было только указать адрес получателя и отправить его), то сейчас выскакивает ошибка (см рис3). Я так понимаю что после переустановок нарушилась связь Excel с почтовиком The Bat. Вобщем я пока в потерях, поисковик конкретики недает (пишут про макросы, а я в них 0) Подскажите где копать?
рис.1

рис.2

рис.3


При открытии редактора VBA - alt+f11. Появилось окно в котором меню Tools - References неактивно(см рис.4). Когда попробывал зайти в VBAProject появилось окно с запросом пароля, которого я незнаю(см рис.5).
рис.4

рис.5


Попробую узнать пароль на макросы...

По поводу рис.5 - OfficeRecovery/Passware тебе в помощь.

По поводу TheBat - проверить, используется ли мыша в качестве почтовика по умолчанию, средствами самого почтовика.

Насчет остального - ИМХО по делу сказать ничего не получится, нужно иметь исходный файл перед глазами.

Люди, натолкните на мысль, как сделать.
В таблице есть строки, где данные забиты в два уровня:
"275,83
40,66"

Вот так, но это не объединеные ячейки. Одна ячейка. Мне надо из таких строк сделать две, разделив данные.

Т.е. из этого:



Должно получиться это:




В ячейке что бы написать второй строкой жмем ALT+Enter - это что перевод каретки называется? По нему отслеживать?

Здравствуйте!
Как в ComboBox сортировать список по алфавиту?

Anton T
Только руками. Загоните содержимое в массив и отсортируйте массив тем же пузырьком.
surgutfred
По последнему вопросу вам Сюда

Цитата:

Одна ячейка. Мне надо из таких строк сделать две, разделив данные.

Код: Dim Arr() as Double
Arr = Split(Cells(I, J), vbNewLine)

Drazhar
Ладно. Нашел вариант от Уокенбаха. Выводит только уникальные и сортирует их.

Уважаемые специалисты по VBA,

уже запарился...

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

Построил функцию на основании вот этого метода:
Charts(sChart).SeriesCollection(sColl).Trendlines(intTrendline).DataLabel.Text

Функция работает вполне прилично. Но дело в том, что для этого приходится вписывать Application.Volatile в функцию и в листе с графиком событие Chart_Deactivate и заставлять Ексель пересчитывать книгу принудительно после каждого захода в лист с графиком, для того, чтобы при изменении уравнения на графике также изменялся его экземпляр в ячейке.
Если таких связок несколько - можно мириться, но если их пару десятков и еще запустить макрос который их использует - начинаются тормоза(начинается пересчет книги).

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

jurris, например Worksheets(0).Cells(I, J).Calculate

Цитата:

А можно еще проще:

Код:
Range("A" & I & ":A" & I + 1) = Split(Cells(I, J), vbNewLine)

Я может не точно выразился, но первоочередной вопрос как мне найти такие ячейки? По какому признаку?

Потому что в таблице есть и обычные строки и такие "двойные"

То что вы предложили - это уже обработка найденного.

ZlydenGL, спасибо.

А как написать событие только для отслеживания изменения текста в уравнениии на графике?
Что-то типа:

Private Sub ChartDataLabelText_Change()
Applicaton.Calculate
End Sub

Такое возможно? Я что-то не нахожу такой возможности. Есть только SeriesChange. Но это не подходит.

surgutfred, найти через .Find(vbNewLine) (или перебором If .Cells(I, J) Like ("*" & vbNewLine & "*") - как удобней).

jurris, вот насчет этого - пас С графиками через VBA не работал.

Снова вместе, снова рядом (с)

Новая головная боль.
Есть файл вида:

Мне требуется наделать новых листов. Количество листов (и соответственно названия - если можно) равно количеству уникальных значений в 3 столбце (т.е. листы Ира, Беня, Влад и т.п.)
Далее перенести в эти самые листы только те строки, где упоминается это самое название листа.

И в чем проблема?

Код: Dim Arr() As String, I As Long, J as Long, K As Byte, WS as Worksheet, Found as boolean, LastRow as Long, LastCol as Byte
LastCol = Cells.SpecialCells(xlLastCell).Column
For I = 1 To Cells.SpecialCells(xlLastCell).Row
Arr = Split(Cells(I, 2), ", ")
For J = LBound(Arr) To Ubound(Arr)
Found = False
For Each WS In ThisWorkbook.Worksheets
If WS.Name = Arr(J) Then
Found = True
Exit For
End If
Next WS
If Not Found Then
Set WS = Worksheets.Add
WS.Name = Arr(J)
End If
LastRow = WS.Cells.SpecialCells(xlLastCell).Row + 1
For K = 1 To LastCol
WS.Cells(LastRow, K) = Cells(I, K)
Next K
Next J
Next I

Это снова я, продолжаю тему про разделение двойных строк. У меня опять "мистика какая то":
Кусочек макроса

Код:
For i = 27 To lLastRow
C = 5
Set N = w.Cells(i, C)
If N Like ("*" & Chr(10) & "*") Then
Z = Split(N, Chr(10))
z1 = Z(0)
z2 = Z(1)
l = i + 1
Rows(l).Select
Selection.EntireRow.Insert , CopyOrigin:=xlUp
End If
Next