столкнулся как раз сегодня с подобной проблемой, давненько не открывал файли и помогло. Большое спасиб!  

Уважаемый Andrew, мне кажется просто вести расчет токов по фазам дело неблагодарное. Я бы вел расчет фазных токов , исходя из заявленной по договору мощности потребителей и раскидывал их по фазам. Для жилых зданий максимальный фазный ток регламентируется ПУЕ и как правило не должен превышать 25 А. Если потребитель включил электрооборудование, которое потребляет выше ток, который ему положен исходя из заявленной по договору  мощности (зная мощность, напряжение=220В, количество фаз -  заявленный ток мы можем посчитать) - понятно, что он нарушает правила пользования электрической энергией и к нему должны быть приняты соответствующие санкции. Конечно, я могу использовать свою заявленную мощность как полностью, так и частично, т.е. одновременно могу включить все электрооборудование или включить, например только лампочку и холодильник - потребляемый ток в этих случаях будет разный. Но это не значит еще, если я бережно включаю электрооборудование не на полную мощность, то меня нужно перекидывать на другую фазу. Ведь кто его знает, может завтра придется включить все электрооборудование на полную мощность - и конечно, если таких потребителей еще найдется несколько десятков, понятно, что произойдет несимметричность фазных токов, которые потянут за собой несимметричность напряжений, ток в нулевой проводе возрастет - что может привести к ненормальному режиму электрооборудования, в худшем случае выходом его из строя. Поэтому, на мой взгляд, подключать потребителей нужно очень и очень внимательно, учтя множество факторов (в том числе и характер нагрузки).

Заходите- Пуск- Свойства планшета (Вашего)-Откроется окно свойства планшета- нажимаете Grip Pen (т.е. перо или может у Вас оно по другому называется)- Выбираете Модификатор- Ставите флажок возле Ctrl.
По крайней мере так я делаю для своего планшета Wacom Intuos4(у меня перо имеет две кнопки, но это неважно).
Рисунки прикрепляю ниже, может по аналогии получится сделать.

Здравствуйте! У Вас какой планшет? Ведь между ними есть некоторая разница. Перо может быть двух кнопочным или трех кнопочним. Можно, например клавишу Ctrl назначить одной из кнопок пера.

http://whoyougle.ru/services/color/list - это супер!!! То что нужно. Всем большое спасибо, вопрос решен.

Спасибо! Стишки должны навести, как правильно дать названия, к тому же настроение поднимают. А чтоб точнее дать названия цветам, сделаю скриншот и в Photoshop посмотрю наличие красного, зеленого и синего, чтобы в названии не ошибиться, какой компоненты больше, т.е. в какую сторону называть компонент, например или это будет бледно-голубой или светло-бирюзовый. В общем будут маленькие эксперименты.

Наверное, придется так и сделать, но названия цветов буду давать не в стиле белый, красный и т.п. а    
"RGB(r,g,b)",    
где r,g,b - реальные числа, которые формируют этот цвет.

Смотрел, но там только 40 цветов и соответственно на них подсказки. А на 56 цветов подсказок нет и цветов этих нет. Все сверял, как раз диапазон цветов 17..32 сюда не входит.

Боюсь, что назову неправильно. Пробовал получить подсказки в Excele, например когда открываю цвет заливки,цвет шрифта или цвет линий -подсказка на названия цвета высвечивается, но только не в  диапазоне цветов i=17...32.

Добрый вечер, форумчане! Хотелось бы сделать следующее:  
В книге Билл Джелен Применение VBA и макросов в Ms Excel на с.121 есть функция, с помощью которой можно получить имя и номер цвета заливки ячейки.  
С номером проблем нет, его можно узнать с помощью цикла  
Sub tt()  
Dim i&  
For i = 1 To 56  
Cells(i, 1).Interior.ColorIndex = i  
Next  
End Sub  
А вот с именем проблемы наблюдаются в диапазоне от i=17 до 32, поскольку в этой книге не присвоены имя этим номерам.Т.е. у него идет  
Select Case myCell.Interior.ColorIndex  
Case 1  
myColor="Черный"  
IndexNum=1  
......... 'в этом промежутке все заполнено нормально  
Case 16  
myColor="Серый 50%"  
IndexNum=16  
А после этого почему-то от Case17 to Case 32 ничего нету и с  
Case33    
myColor="Голубой"    
IndexNum=33  
..........    'в этом промежутке тоже все заполнено нормально  
Case56    
myColor="Серый 80%"  
IndexNum=56  
Может у кого-то есть названия этих цветов, поскольку я хочу с помощью выше приведенного цикла вывести цвет и рядом в соседней ячейки имя цвета, например вот так  
Sub tt()  
Dim i&, arrColor()  
arrColor = Array( _  
"Черный", "Белый", "Красный", "Ярко-зеленый",....)  
For i = 1 To 56  
Cells(i, 1).Interior.ColorIndex = i  
Cells(i, 2).Value = arrColor(i - 1)  
Next i  
End Sub

сканера на данный момент нету, поскольку предыдущий поломался и думаю купить быстрый сканер. Может кто-то посоветут? Если раньше меня никто не скинет информацию- надеюсь это сделаю.

Приложение А. Объектная модель Excel 2003 (начиная с 655с )  
Приложение Б. Объектная модель VBE  
Приложение В. Объектная модель Office 2003  
В этих приложениях подробно на русском языке описаны выше упомянутые объектные модели, которые сопровождаются изредка небольшими примерами кода. В книгах Уокенбаха этого нет, так грубо говоря все есть. Но это компенсирует справочная информация по VBA на компьютере, которая идет на английском.

Здравствуйте! Соглашусь с Вами- эту книгу на данный момент найти сложно. Издательский дом "Вильямс", 2006.-1088 с. Книга идет без диска. В ней наиболее полно освещена информация по программированию на VBA в Excel, но хитростей и примочек здесь я не нашел. Думаю, если есть Уокенбах, то это не такая уж потеря,поскольку в книге Уокенбаха Профессиональное программирование на VBA идет диск со множеством хороших примеров.

у меня книга в бумажном варианте, которая постоянно под рукой, если я что-то не знаю по функциям и не только.  
ББК 32.973.26-018.1  
УДК 004.432  
Король В.И.  
Visual Basic 6.0, Visual Basic for Application 6.0. Язык программирования.  
Справочник с примерами. Издание второе, исправленное. -М.:КУДИЦ-ОБРАЗ, 2000.-448с.  
ISBN 5-93378-005-7  
Книга является систематизированным справочником по всем элементам языка программирования Visual Basic 6.0, Visual Basic for Application 6.0.  
Помимо тех официальных сведений, которые можно найти в документации и в справочной системе, книга содержит конкретные примеры, рекомендации и маленькие хитрости программиста, а также поправки к справочной системе, которая, увы, не без ошибок.  
Книга предназначена для всех специалистов, занимающихся разработкой приложений с применением Visual Basic, Visual Basic for Application.    
Если найдете, пользуйтесь на здоровье!

ikki, Вы попробуйте взять ОЧЕНЬ длинную строку со множеством точек и так далее и протестировать код ZVI и мой последний на Split.    
1)Дело в том, что в InStr на очень длинных строках при текстовом методе сравнения(vbTextCompare) имеется некая "блоха", которая генерирует ошибку времени исполнения 28: Stack overflow при поиске в диапазоне позиций 258759-277240. Обойти ее можно, переведя исходную строку и образец в один регистр и перейдя на бинарное сравнение (vbBinaryCompare).  
*************  
2)У Split, как и у ряда других строковых функций VB/VBA версии 6, имеется тоже "блоха". Дело в том, что значение константы, задающей метод сравнения по установкам базы данных(vbCompareDataBase или vbUseCompareOption при установленной Option Compare DataBase), они путают с имеющим то же значение LCID болгарского языка(LANGBULGARIAN/SUBLANGNEUTRAL).Поэтому, если поддержка болгарского языка на машине не установлена, генерируется ошибка времени исполнения 5: Invalid procedure call argument, а если установлена, вы имеете болгарскую сортировку. С этой проблемой легче всего столкнуться в MS Access 2000.  
***  
Вот почему мне больше нравится Split. И думаю, в этом случае код будет универсальнее ZVI и более гибкий, поскольку здесь открывается доступ к массивам.

Если точки НЕ будут идти подряд на 400 позиции и 401, то мой вариант сработает правильно, конечно, если точки идут подряд на выше указанных позициях, то конечно Вы правы.Этот баг заметил, когда код уже скинул. Нужно записать  
.Value = Mid(.Value, 1, 400) & Split(Mid(.Value, 401), ".")(0)

еще один вариант  
Sub Tochka4()  
With ActiveCell  
.Value = Mid(.Value, 1, 399) & Split(Mid(.Value, 400), ".")(0)  
End With  
End Sub

Тогда будет в таком виде  
Sub Tochka3()  
Dim i&  
With ActiveCell  
For i = 401 To Len(.Value)  
If Mid(.Value, i, 1) = "." Then  
.Value = Mid(.Value, 1, i - 1): Exit For  
End If  
Next i  
End With  
End Sub

извините меня Prist,поспешил.После Ваших слов наконец въехал в задание. Про код ZVI я молчу- он универсальный. Я имел ввиду свой код, поскольку я подумал что у автора в ячейках имеется текст, где на 401 позиции стоят точки, после который нужно все убрать, потом понял, а вдруг попадется текст вообще без точек или точки будут на другой позиции, поэтому и добавил условие If Mid(.Value, 401, 1) = "." и написал, что так будет универсальнее. Дело в том что я хочу показать, что решить эту задачу можно применяя всего лишь одну функцию МID. Но вижу, что еще в таком случае нужно задействовать функию Len и цикл.

извините, правильнее и универсальные будет так, ведь в ячейках может быть точка или не быть, или быть, но на другой позиции.  
Sub Tochka_1()  
Dim i&  
With ActiveCell  
If Mid(.Value, 401, 1) = "." Then  
.Value = Mid(.Value, 1, 400)  
End If  
End With  
End Sub

Здравствуйте! Попробуйте еще вот так:  
Sub Tochka()  
Dim i&  
With ActiveCell  
.Value = Mid(.Value, 1, 400)  
End With  
End Sub

Здравствуйте! Нравятся такие задачки, код можно еще так записать:  
Function SumNums_2(stroka As String)  
Dim b&, i&  
If Len(stroka) <= 1 Then SumNums_2 = stroka: Exit Function  
While Len(stroka) > 1  
For i = 1 To Len(stroka)  
b = Val(b) + Val(Mid(stroka, i, 1))  
Next i  
stroka = b: b = 0  
Wend  
SumNums_2 = stroka  
End Function

Здравствуйте, господа! Предлагаю вот такую идею:  
Sub NORUS_1()  
Dim arr$(), rov&, col&  
Dim stroki As Range, str As Range, a As Range, x As Range  
rov = activecell.Row: col = activecell.Column:  
' stroki- список строк  
Set stroki = Range(Cells(rov, col), Cells(Rows.Count, col).End(xlUp))  
' a- список символов, которые подлежат замене  
Set a = Range(Cells(rov, col + 1), Cells(Rows.Count, col + 1).End(xlUp))  
For Each str In stroki  
For Each x In a  
arr = Split(str, x)  
str = Join(arr, "")  
Next x  
Next str  
End Sub  
 
Например, у меня есть список уже выведенных символов в своей базе- русские, греческие, латинские, специальные знаки. Можно просто их скопировать в нужный столбец, у меня это (row, col+1). Очень хорошо справляется с повторами символов.

Что касается построения Вашего графика функции в Excel, я бы построил его следующим образом  
1)вначале разбиваем сложный график на два более простых  
y1=1+cos(x)  
y2=1/(1+e^(2x))  
C графиком функции y1=1+cos(x) все понятно - это кривая cos(x)смещенная в положительном напралении по оси ординат на единицу.    
График функции y2=1/(1+e^(2x))-это кривая, которая ограничена вверху асимптотой y=1, а внизу - асимптотой y=0.  
Наш график функции y=y1*y2=(1+cos(x))*(1/(1+e^(2x)) получился путем умножения графиков функций y1 и y2 - на языке биологии говоря, он получился в результате скрещивания y1 и y2, т.е. в данном случае он должен быть похож на своих родителей y1 и y2.  
2)Начиная с точки x=1,571 и до бесконечности ми будем иметь практически затухающую косинусоиду. Хотя на точечной диаграмме лист2 эта затухающая косинусоида отображается как прямая линия ввиду большой малости этой функции на данном участке. Это очень важный момент для качественного построения графика. Поэтому я и разбил график y=y1*y2 на два графика y1 и y2, чтобы посмотреть, что будет на самом деле.  
3) чтобы отобразить большинство данных на графике и получить более гладкую кривую я взял больше данных для построения и шаг сделал PI/10.  
На листе1 -данные для построения графиков функции y, y1,y2  
лист2- точечная диаграмма графика функции y  
лист3-  y1 и y2.

на той части графика, где уже явно видно его направление в сторону приближения к асимптоте, можно уменьшить количество агрументов xk...,xn+1, но при этом увеличить между ними расстоянии, т.е. dxk=xk+1-xk - результат построения на точечной диаграмме будет практически одинаков, только с меньшим количеством данных для построения.

Привет! Математически можно сделать таким образом:  
1) строим графики функций    
y1=1+cos(x)  
y2=1+e^(2x)  
2)далее делим ординаты графика функции y1=1+cos(x) на ординаты графика функции  
y2=1+e^(2x) при значениях аргумента x1, x2, ..., xk  
При этом учитываем, если x приближается к бесконечности, то (1+сos(x))<=2,  
1+e^(2x) приближается к бесконечности, значит y=y2/y1 будет приближаться к нулю, т.е. y приближается к 0 при x приближается к бесконечности, т.е. ось абсцисс будет асимптотой графика функции y=y1/y2.    
Асимптоты нашли, дальше ищем промежуточные значения.

только после Sub PoliXY() при записи макрос автоматически добавляет комментарии,т.е. на моем компьютере он выделяет 6 строк по комментарии, включая пустую предпоследнюю строчку:  
Sub PoliXY()  
'  
' Макрос1 Макрос  
' Макрос записан 18.10.2012 (Admin)  
'  
 
'  
/РабочийКод/  
End sub  
 
тогда все будет работать правильно.

Привет всем! Хочу поделиться тем, что я хотел изначально сделать. Только, здесь у меня xr, yr (от слова xreal, yreal)-истинные координаты. Предлагаю на рассмотрение, получившийся код, который извлекает координаты из записанного макроса, в данном случае из макроса PoliXY  
Sub Coord_XY_2()  
Dim arr$(), ProcName$, x#(), y#(), dx#(), dy#()  
Dim sumx#, sumy#, xнач#, yнач#, xr#(), yr#()  
Dim i&, n&, nLines&, dn0&, dnk&, rov&, col&  
Dim VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule  
Set VBComp = ActiveWorkbook.VBProject.VBComponents("PoliXY")  
Set CodeMod = VBComp.CodeModule  
ProcName = "PoliXY"  
dn0 = 8: dnk = 3: rov = 1: col = 4: xнач = 10: yнач = 10  
With CodeMod  
nLines = .ProcCountLines(ProcName, vbext_pk_Proc)  
ReDim Preserve x(1 To nLines - dn0 - dnk)  
ReDim Preserve y(LBound(x) To UBound(x))  
ReDim Preserve dx(LBound(x) - 1 To UBound(x) - 2)  
ReDim Preserve dy(LBound(x) - 1 To UBound(x) - 2)  
ReDim Preserve xr(LBound(x) To UBound(x))  
ReDim Preserve yr(LBound(x) To UBound(x))  
For i = LBound(x) To UBound(x)  
arr = Split(Replace(Replace(Replace(Mid(.Lines(i + dn0, 1), 51), _  
         ",", ""), "#", ""), ".", ","), " ")  
x(i) = arr(0)  
y(i) = arr(1)  
Next i  
End With  
For n = LBound(x) To UBound(x) - 1  
dx(n - 1) = x(n + 1) - x(n)  
dy(n - 1) = y(n + 1) - y(n)  
sumx = sumx + dx(n - 1)  
sumy = sumy + dy(n - 1)  
xr(n) = xнач + sumx  
yr(n) = yнач + sumy  
Cells(n + rov, col) = xr(n)  
Cells(n + rov, col + 1) = yr(n)  
Next n  
Cells(rov, col) = xнач  
Cells(rov, col + 1) = yнач  
End Sub

Благодарю Вас Hugo и Казанский! Я очень рад, что после трех усиленных дней раздумия сумел составить эти два кода для извлечения координат из записанного макроса (ну ладно, в другой своей теме отпишусь). С учетом дельных пожеланий Казанского код получился более наглядным. Перепишу рабочий вариант, может быть кому-то из форумчан он пригодится:  
Sub Arrwer(arr)  
Dim j As Long, x  
For j = LBound(arr) To UBound(arr)  
x = Replace(arr(j), "#", "")  
x = Replace(x, ",", "*")  
x = Replace(x, ".", ",")  
x = Split(Mid(Trim(Mid(x, 1, Len(x))), 42), "*")  
Cells(j + 1, 18).Resize(, 2) = x  
Next j  
End Sub  
**********************  
Sub CopyLinesPoliXY()  
Dim arr()  
Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent  
Dim CodeMod As VBIDE.CodeModule  
Dim nLines As Long, ProcName As String  
Set VBProj = ActiveWorkbook.VBProject  
Set VBComp = VBProj.VBComponents("PoliXY")  
Set CodeMod = VBComp.CodeModule  
ProcName = "PoliXY"  
With CodeMod  
nLines = .ProcCountLines(ProcName, vbext_pk_Proc)  
ReDim Preserve arr(1 To nLines - 3 - 8)  
For i = 1 To nLines - 3 - 8  
   arr(i) = .Lines(i + 8, 1)  
Next i  
End With  
Arrwer arr  
End Sub  
 
В первом коде при тестировании на строчке  
x = Replace(arr(j, 1), "#", "")  
выдавалась ошибка(хотя раньше работало все нормально), поэтому пришлось переписать ее так  
x = Replace(arr(j), "#", "")

Всем привет! Понимаю, что тема не новая, но что-то у меня не получается...  
Есть процедура CopyLinesPoliXY() в которой параметр arr() нужно передать процедуре  
Arrwer()  
Sub CopyLinesPoliXY()  
Dim arr()  
Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent  
Dim CodeMod As VBIDE.CodeModule  
Dim nLines As Long, ProcName As String  
Set VBProj = ActiveWorkbook.VBProject  
Set VBComp = VBProj.VBComponents("PoliXY")  
Set CodeMod = VBComp.CodeModule  
ProcName = "PoliXY"  
With CodeMod  
nLines = .ProcCountLines(ProcName, vbext_pk_Proc)  
ReDim Preserve arr(1 To nLines - 3 - 8)  
For i = 1 To nLines - 3 - 8  
   arr(i) = .Lines(i + 8, 1)  
Next i  
End With  
End Sub  
************************  
Sub Arrwer(arr() As String)  
Dim j As Long, arr(), a(), b(), c(), d()  
ReDim Preserve a(LBound(arr) To UBound(arr))  
ReDim Preserve b(LBound(arr) To UBound(arr))  
ReDim Preserve c(LBound(arr) To UBound(arr))  
ReDim Preserve d(LBound(arr) To UBound(arr))  
For j = LBound(arr) To UBound(arr)  
b(j) = Replace(arr(j, 1), "#", "")  
c(j) = Replace(b(j), ",", "*")  
d(j) = Replace(c(j), ".", ",")  
a(j) = Split(Mid(Trim(Mid(d(j), 1, Len(d(j)))), 42), "*")  
Cells(j + 1, 18).Resize(, 2) = a(j)  
Next j  
End Sub  
 
Как здесь передать arr().  
Например, раньше в процедуре Arrwer() массив arr() я брал из нужных ячеек вот так:  
arr = Range(Cells(2, 10), Cells(Rows.Count, 10).End(xlUp))  
но в данном случае это лишнее действие и его нужно правильно передать.