Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA (часть 2)

Автор: Oyger
Дата сообщения: 02.11.2007 16:30
vasiliy74

Цитата:
как при открытии проверять имя пользователя

If Application.UserName = "....." Then
Автор: vasiliy74
Дата сообщения: 02.11.2007 16:47
Application.UserNamе даёт имя то что в excel прописано а как получить NT аунтетификации?
Автор: ol7ca
Дата сообщения: 02.11.2007 16:49
Oyger


Заработало. Cпасибо.
Автор: Olive77
Дата сообщения: 02.11.2007 17:05

Цитата:
Application.UserNamе даёт имя то что в excel прописано а как получить NT аунтетификации?

Environ$("UserName")
Автор: vasiliy74
Дата сообщения: 02.11.2007 17:36
Olive77
Супер! Спасибо Огромное!! Всё переискал...

Добавлено:
Ещё думаю как бы сравнить имя получаемое Environ$("UserName") корректно, чтобы регистр букв верхний и нижний не участвовал?
Автор: Olive77
Дата сообщения: 02.11.2007 18:59
ucase()
Автор: CEMEH
Дата сообщения: 04.11.2007 14:13
С ListBoxs-ом разобрался. Но появился другой вопрос:

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

Добавлено:
Вот еще вопрос по датам

Есть некая большая веб таблица, ее вставляю в лист. Потом ее обрабатывает макрос (строковая переменная, массив)
В один из столбцов ставятся даты. И даты эти вставлены как строковая переменная. Чем их преобразовать в формат даты- не знаю. Но если дважды щелкнуть на ячейке то дата принимает нормальный вид.
Автор: SERGE_BLIZNUK
Дата сообщения: 04.11.2007 16:40
CEMEH

Цитата:
В один из столбцов ставятся даты. И даты эти вставлены как строковая переменная. Чем их преобразовать в формат даты- не знаю.

тут уже был подобный вопрос...
попробуйте для нужной ячейки (замените на свой код!)
.NumberFormat = "m/d/yyyy"
.FormulaLocal = "01.12.2009"


Автор: denisdenmm
Дата сообщения: 04.11.2007 17:48
ЕСЛИ кому нибудь нужен прикольный шаблон с формой размеры которой вместе с расположенным на ней листбоксом увеличиваются и уменьшаются соразмеримо величине шрифта листбокса, при этом все названия в листбоксе не обрезаются, то делюсь по братски
(сам сотворил, просто хотел похвастаться)
можно применять если списки очень сильно ветвятся и тексты бывают очень длинными, как у меня получилось, с чего и завёлся собственно говоря
(Label1.Label2.Label3. чисто для видимости размеров, как бы не нужны, но вместо них можно располагать кнопки и прочее, прочее)
короче вот код, а в форме присутствуют Label1.Label2.Label3.Label4,SpinButton1,ListBox1,ComboBox1, брошенные в неё как попало

Private Sub Label4_Click()
ListBox1.Visible = True
End Sub

Private Sub ListBox1_Click()
Label4.FontSize = SpinButton1.Value
Label4.Caption = "G"
Label4.AutoSize = True
Label4.AutoSize = False
ComboBox1.Value = ListBox1.Value
Label4.Caption = ListBox1.Value
Label4.Width = ComboBox1.Width - 22
ListBox1.Visible = False
End Sub
Private Sub SpinButton1_Change()
ListBox1.Visible = False 'почему-то без этого не действует
ComboBox1.FontSize = SpinButton1.Value
ListBox1.FontSize = ComboBox1.FontSize
Call опачки
ListBox1.Visible = True 'почему-то без этого не действует
End Sub

Private Sub UserForm_Initialize()
UserForm1.StartUpPosition = 0: UserForm1.Left = 3: UserForm1.Top = 3
SpinButton1.Height = 30: SpinButton1.Max = 60: SpinButton1.Min = 5: SpinButton1.Value = 8 _
'величина 8-обязательно, по крайней мере не меньше
Label1.Left = 1: Label1.Height = 16: Label1.AutoSize = True: Label1.Width = 50
Label2.Left = 1: Label2.Height = 16: Label2.AutoSize = True: Label2.Width = 50
Label3.Left = 1: Label3.Height = 16: Label3.AutoSize = True: Label3.Width = 50
SpinButton1.Left = 2: SpinButton1.Top = 2: SpinButton1.Width = 15
ComboBox1.Visible = False: ComboBox1.AutoSize = True
ComboBox1.FontSize = SpinButton1.Value
Label4.FontSize = SpinButton1.Value
Label4.Caption = "G": Label4.AutoSize = True
ListBox1.FontSize = ComboBox1.FontSize
ListBox1.Top = SpinButton1.Top + SpinButton1.Height + 2
Label4.Top = SpinButton1.Top + SpinButton1.Height + 2
Label4.Left = 0
ListBox1.Left = 0
Call опачки
End Sub
Function опачки()
LastRow = Range("A1:C17").End(xlDown).Row
ListBox1.RowSource = "A1:C" & LastRow
ComboBox1.RowSource = "A1:A" & LastRow
размер1 = 0
размер2 = 0
размер3 = 0
For i = 0 To LastRow - 1
ComboBox1.ListIndex = i
If размер1 < ComboBox1.Width + 5 Then
размер1 = Round(ComboBox1.Width + 5)
End If
Next
ComboBox1.RowSource = "B1:B" & LastRow
For i = 0 To LastRow - 1
ComboBox1.ListIndex = i
If размер2 < ComboBox1.Width + 5 Then
размер2 = Round(ComboBox1.Width + 5)
End If
Next
ComboBox1.RowSource = "C1:C" & LastRow
For i = 0 To LastRow - 1
ComboBox1.ListIndex = i
If размер3 < ComboBox1.Width + 5 Then
размер3 = Round(ComboBox1.Width + 5)
End If
Next
i = размер1 & ";" & размер2 & ";" & размер3
ListBox1.ColumnWidths = (i)
ListBox1.Width = 3 + размер1 + размер2 + размер3
ListBox1.Height = LastRow * (ListBox1.FontSize + ListBox1.FontSize / 4) + 3
UserForm1.Width = ListBox1.Width + 2
Label1.Top = ListBox1.Height + ListBox1.Top + 3
Label1.Caption = i
Label2.Top = Label1.Height + Label1.Top + 1
Label2.Caption = ListBox1.Width
Label3.Top = Label2.Height + Label2.Top + 1
Label3.Caption = ListBox1.Height
UserForm1.Height = Label3.Height + Label3.Top + 25
End Function

Автор: CEMEH
Дата сообщения: 05.11.2007 03:12
SERGE_BLIZNUK
если руками делаю формат ячейки дата то ничего не меняется.
Вышел из положения так:
dim a(1000,10) as string ' эта переменная из которой все проставляется в ячейки.
'добавил еще переменную
dim D as date
' и теперь для заполнения ячеек использую ее как некий преобразователь
' и если раньше было так
range("A" & x) = a(x,y)
' то теперь так:
D=a(x,y)
range("A" & x) = D
Автор: denisdenmm
Дата сообщения: 05.11.2007 03:56
а я преобразовываю Label из текстовой переменной в число умножая на 1:
например
i=Label1.Caption*1
потому что i= IsNumeric(Label1.Caption) не срабатывает
выдаёт 0
Автор: SERGE_BLIZNUK
Дата сообщения: 05.11.2007 09:11
denisdenmm
а так пробовали?
i= cDbl(Label1.Caption)
хотя, если с умножением работает - зачем что-то ещё пробовать.... ;-)

CEMEH
кстати, не хочется сейчас проверять, но вы можете попробовать
вместо
range("A" & x) = D
попробовать
range("A" & x) = CDate(a(x,y))
Автор: qEraser
Дата сообщения: 05.11.2007 17:33
Подскажите, как удалить все строки (максимум 30), кроме 1й и на которой стоит курсор?

Зачем нужно: формируется таблица и в распечатку должны попадать 1я строка(шапка) и та, на которой выделена ячейка.
Автор: SERGE_BLIZNUK
Дата сообщения: 05.11.2007 18:16
qEraser
у Вас ник такой, прямо для удаления чего-нибудь создан... ;-))
попробуйте код
Код:
Dim i, CurRow As Long
CurRow = ActiveCell.Row
For i = 30 To 2 Step -1
If i <> CurRow Then Cells(i, 1).EntireRow.Delete
Next i
Автор: dneprcomp
Дата сообщения: 05.11.2007 19:07
denisdenmm
IsNumeric функция для проверки на наличие числовых данных. Вот она тебе честно и отдает True. Умножение ничего не дает, кроме дополнительной нагрузки в виде явных и не явных преобразований. Тогда уж проще и лучше присваивать значение напрямую: i=Label1.Caption. Будет всего одно не явное преобразование.
Для явного преобразования используй Type Conversion Functions - CBool, CByte, CCur, CDate, CDbl, CDec, CInt, CLng, CSng, CStr, CVar
Автор: qEraser
Дата сообщения: 06.11.2007 00:08
SERGE_BLIZNUK

Цитата:
хотя, мне лично очень не нравится постановка "(максимум 30)"... но воля ваша...

Често говоря, написал максимальное значение, т.к. подумал, что так проще будет реализовать задусанное. Если есть более краивое решение, было бы здорово.

Решение предложенное Вами работает, спасибо.
Автор: SERGE_BLIZNUK
Дата сообщения: 06.11.2007 07:51
qEraser

Цитата:
Често говоря, написал максимальное значение, т.к. подумал, что так проще будет реализовать задуманное.

ну проще, то проще... а если в таблице будет больше - тогда прийдётся макрос править...
я бы предложил одно из двух решений:
1) максимум занятых строк на листе
nr = ActiveSheet.UsedRange.Rows.Count
либо
2) последняя занятая строчка в указанном вами столбце:
lastrow = Cells(ActiveSheet.UsedRange.Rows.Count,col).End(xlUp).Row
col - номер нужного столбца. (ну, допустим в каком-то столбце идёт нумерация, вот его и указать

впрочем, если всё работает, и Вас устраивает.... ;-))
Автор: denisdenmm
Дата сообщения: 06.11.2007 10:17
dneprcomp между прочим большое спасибо, так как до сих пор операторов знаю мало, и как правило приходится изобретать велосипед, там посмотришь, там
иной раз весь день уходит, чтобы найти что-то в нете, (причём когда ищешь не факт что это вообще возможно)


Добавлено:

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

Зачем нужно: формируется таблица и в распечатку должны попадать 1я строка(шапка) и та, на которой выделена ячейка.

я вот подумал, а не проще ли скрыть ячейки, зачем их удалять, ведь скрытые в распечатку не попадают
у меня кстати вопрос есть такой
вот при вызове функции переменные теряются (ну те что в sub присутствуют) и я как правило присваиваю эти значения переменных например Label1.Caption (присваиваю в sub), а затем уже (в функции) использую как например t=Label1.Caption*1 (действие какое либо) и уже в конце функции опять Label1.Caption=t ну и продолжается sub
вот отсюда вопрос, как обойтись без этого
Автор: vasiliy74
Дата сообщения: 06.11.2007 10:46
как сделать так чтобы значения, например: Local = local, при сравнении были равны? это строкавые переменные имеют такие значения.
Автор: denisdenmm
Дата сообщения: 06.11.2007 10:57

Цитата:
как сделать так чтобы значения, например: Local = local, при сравнении были равны? это строкавые переменные имеют такие значения.

if Local <> local then Local = local

Добавлено:
или если после всего они должны остаться при своих то
if Local <> local then
Промеуток = Local
промеуток = local
Промежуток = промежуток (или наоборот)
end if
если честно то непонятно для чего нужно отсюда и нелепость подсказки

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


и вопрос номер 2
я создал калькулятор (ну простенький "-","+","*","/", "корень", 4-ре памяти, короче не для инженерных расчётов, а завёлся собственно с того что у не знал как програмно использовать виндоусовский, то есть я его могу програмно вызвать а что с ним делать дальше не знаю,
так вот вопрос такой (меня мой сделанный с помощью ехеля устраивает больше, всё же четыре памяти и видно что в каждой из них находится, но иногда можно попроще, да и виндоусовский покрасивше - кнопочки овальные, то, сё)
так вот, как после програмного вызова виндоускалькулятора можно так же програмно его использовать

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

Добавлено:
кстати прикольно получилось написал с целью узнать что получится
ActiveCell.Value = (ActiveCell.FormulaR1C1 = "='D:\[материалы 2.xls]р'!R10C6")
в итоге в активной ячейке получилось значение ЛОЖЬ
в принципе вышла интересная штука, с которой можно дальше что-то пробовать,
если кому надо возмите на заметку

Добавлено:
активная ячейка была пустой !!!!!
Автор: vasiliy74
Дата сообщения: 06.11.2007 15:11
denisdenmm
Наверно суть вопроса я выразил не явно, нужно чтобы при сравнении строковых переменных регистр не учитывался.... как?
Автор: SERGE_BLIZNUK
Дата сообщения: 06.11.2007 15:48
vasiliy74
приводите строковые переменные к одному регистру (например UCase)
if UCase(Var1) = UCase(var2) Then

Автор: qEraser
Дата сообщения: 06.11.2007 16:43
SERGE_BLIZNUK
Большое спасибо за время потраченное Вами, конечно же предложенные во втором посте решения универсальнее.

1) Как выделить диапозон ячеек используя переменную?
Задача - известана ширина таблицы, а длина - переменная. Нужно выделить эту таблицу и нарисовать все границы.

2) Существует заголовок таблицы (Журнал выдачи экспортных/импортных справок). Причем "экспортных" или "импортных" подставляется в зависиомсти от того, какие последние 3 цифры в номерах заданной длины в заданной колонке.

Например:

12345678/0000/0000/2/0 и 12345678/0000/0000/4/0 - Импорт
12345678/0000/0000/1/0 и 12345678/0000/0000/3/0 - Экспорт

Т.е. колонка может быть или с импортными номерами или с экспортными. И в зависимости от этого меняется переменная в заголовке. Возможно ли такое осуществить?
Автор: CEMEH
Дата сообщения: 06.11.2007 18:35
qEraser
То есть вам надо определить последнюю заполненную строку?

Если в таблице заполнены все ячейки то подойдет =СЧЁЕЗ(A:A)
Или в коде VBA
=Application.WorksheetFunction.CountA(Range("A:A"))
Есть еше способы, мне в этой теме на подобный вопрос уже отвечали.

Ну а все остальное (границы, шрифт, оформление) проще, наверное, сделать через запись макросов

Возможно, специалисты предложат более простое решение решение.
Автор: SERGE_BLIZNUK
Дата сообщения: 06.11.2007 18:44
qEraser
1) не понял - что значит "выделить" ? select ?
или цветом?
вот, пример выделения цветом диапазона от A1 до D6
Код:
Range(Cells(1, 1), Cells(6, 4)).Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
Автор: GreenRay
Дата сообщения: 06.11.2007 20:38
Требуется выделять красным цветом в Диаграмме (Гистограмме) столбик, если соответствующее ему значение в таблице > 5


Код:
Sub Макрос1()
Worksheets("Лист1").ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select
Set cr = Worksheets("Лист1").ChartObjects("Chart 1").Chart.SeriesCollection(1)
j = 0

For Each cell In Sheets("Лист1").Range("b4:b12")
j = j + 1
Set ch = cr.Points(j)
if cell >= 5 Then
ch.Interior.ColorIndex = 3 'Красный цвет
Else
ch.Interior.ColorIndex = 2 'Белый цвет
End If
Next cell

End Sub
Автор: dneprcomp
Дата сообщения: 06.11.2007 20:59
denisdenmm

Цитата:
вот при вызове функции переменные теряются (ну те что в sub присутствуют) ия как правило присваиваю эти значения переменных например Label1.Caption (присваиваю в sub), а затем уже (в функции) использую
Просто объявляй переменные не в sub, а в модуле. Тогда они будут видны во всех процедурах. И существовать будут пока существует модуль.
Автор: denisdenmm
Дата сообщения: 06.11.2007 23:41
народ, я вот задавал ещё вопросы, наверно их никто не увидел, я попробую повторить, может быть кто-нибудь выручит
Цитата:
Добавлено:
у меня есть ещё такой вопрос, в форме есть текстбокс,
как для него установить возможность копирования из него и вставки скопированного в него путём нажатия правой кнопки мыши
я повозился сам и использовал для этого просто ячейку рабочего листа, ну то есть кнопка "вставить" вставляет то что в буфере обмена в определённую ячейку (причём если в буфере несколько строк то естественно в ячейке только верхняя строка (что мне собственно и нужно) а затем текстбокс = величине этой ячейки, в принципе уже работает прекрасно, но на будущее, если не трогать рабочий лист, можно ли как то осуществить подобное


и вопрос номер 2
я создал калькулятор (ну простенький "-","+","*","/", "корень", 4-ре памяти, короче не для инженерных расчётов, а завёлся собственно с того что у не знал как програмно использовать виндоусовский, то есть я его могу програмно вызвать а что с ним делать дальше не знаю,
так вот вопрос такой (меня мой сделанный с помощью ехеля устраивает больше, всё же четыре памяти и видно что в каждой из них находится, но иногда можно попроще, да и виндоусовский покрасивше - кнопочки овальные, то, сё)
так вот, как после програмного вызова виндоускалькулятора можно так же програмно его использовать

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

Добавлено:
кстати прикольно получилось написал с целью узнать что получится
ActiveCell.Value = (ActiveCell.FormulaR1C1 = "='D:\[материалы 2.xls]р'!R10C6")
в итоге в активной ячейке получилось значение ЛОЖЬ
в принципе вышла интересная штука, с которой можно дальше что-то пробовать,
если кому надо возмите на заметку

Добавлено:
активная ячейка была пустой !!!!!



Добавлено:
dneprcomp
большое спасибо за участие
Автор: SAS888
Дата сообщения: 07.11.2007 07:34
Для работы с "Виндосовским" калькулятором (как и с множеством других вызываемых приложений) можно использовать метод SendKeys.
Например:
Dim ReturnValue, I
ReturnValue = Shell("CALC.EXE", 1) ' Запускаем калькулятор
AppActivate ReturnValue ' Активизируем калькулятор
For I = 1 To 100 ' Циклимся 100 раз
SendKeys I & "{+}", True ' Посылаем нажатие на клавишу в калькулятор
Next I ' Добавляем к значению в калькуляторе переменную I
SendKeys "=", True ' Нажимаем на знак равенства
SendKeys "%{F4}", True ' Посылаем Alt+F4 для закрытия калькулятора

Коды клавиш можно найти в стандартном Helpe в VBA Excel.
Автор: GreenRay
Дата сообщения: 07.11.2007 09:12
Попробовал сделать так, чтобы не надо было каждый раз в макросе менять диапазоны ячеек (B4:B12), но не получается без него пока.

Есть задумки, но не знаю как их реализовать:
1. Получить диапазон ячеек, на основании которого строится ряд и его подставлять при сравнении
2. При обращении к столбцу ряда гистограммы получить значение (или номер ячейки), на основании которого формируется значение столбца.

У метода Points нет Value, но при наведении на столбец указателем мышки, показывает "Значение:50. " (Собака!)
Подскажите, люди добрые, в каком направлении плыть ?



Код:
Sub Макрос1()

Set cr = Worksheets("Лист1").ChartObjects("Chart 1").Chart.SeriesCollection(1)
' j = 0

For j=1 to cr.Points.Count ' Чтобы не зависить от привязки к диапазону ячеек b4:b12
' For Each cell In Sheets("Лист1").Range("b4:b12")
' j = j + 1
Set ch = cr.Points(j)
if cell >= 5 Then
ch.Interior.ColorIndex = 3 'Красный цвет
Else
ch.Interior.ColorIndex = 2 'Белый цвет
End If
'Next cell
Next j

End Sub

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133

Предыдущая тема: Написание своего HyperTerminal для считывания данных


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.