» Excel VBA (часть 3)

Последний цикл можно вот так сделать:

Код: For i = 1 To col
Лист1.Cells(i + 1, 1) = Mid(RTrim(Vse(i).Kompany), 19)
Лист1.Cells(i + 1, 2) = Mid(RTrim(Vse(i).Adress), 7)
tel = Mid(RTrim(Vse(i).Phone), 11)
Лист1.Cells(i + 1, 3) = Mid(tel, 1, Len(tel) - 2) 'Чтобы срезать с конца строки ;"
mail = Mid(RTrim(Vse(i).e_mail), 8)
mail1 = Replace(mail, ":", "")
Лист1.Cells(i + 1, 4) = Replace(mail1, """", "")
Next i

Maximus777
я имел ввиду этот код кнопки, ну со всеми дополнениями внесёнными

Добавлено:
но это я совсем загнался %)
можно в Экселе посмотреть же

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

Maximus777
огромное спасибо за помощь!

Ребята! Подскажите как из VBA писать у текстовый файл? Нужно в процедурах открития и закрития файлов записивать Юзера и время...

hackman

Код: Open "d:\1.txt" For Output As #1
Print #1, "bla-bla-bla"
Close #1

Сам отвечу,
[code]

Open "H:\ABT\Payments managment\backup\syslog.txt" For Append As #1
'MsgBox s
'append
t = CStr(Time)
Text = CStr(Application.UserName) & " " & (t) & " Ñlose"
Write #1, Text
Close #1
[code]


Добавлено:
да но я написал в режиме Append

Всем доброго времени суток!

При переходе с одной вкладки MultiPage на другую ListView смещается в верхний левый угол формы. Решение есть для Access, например:


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 Sub НаборВкладок_Change()

Const WM_SIZE As Long = &H5

SendMessage Me.hWnd, WM_SIZE, 0, 0

End Sub,

но не подходит для Excel.
Вопрос, - какой код устранит смещение ListView при переходе с одной вкладки на другую в MultiPage для Exsel 2003?

Цитата:

не подходит для Excel

Должно подходить. Эта функция единая для всех приложений Windows.
Какой ListView Вы используете? Я разместил на вкладке Microsoft ListView Control ver.6 и этой функции не надо. При переключении вкладок он не меняет своего положения.

http://www.cyberforum.ru/vba/thread631436.html

Добавлено:
В коде:

Private Sub MultiPage1_Change()
Const WM_SIZE As Long = &H5
SendMessage Me.hWnd, WM_SIZE, 0, 0
End Sub

ошибка на Me.hWnd - Compile error: Method or data member not found

Mishel917
Цитата:

ошибка на Me.hWnd - Compile error: Method or data member not found

Так Вам ListView надо сдвигать или чего? Вот от него и берите хендл, ListView1.hWnd.

А вообще непонятно, почему что-то сдвигается. Вот пример - ссыль. Ничего и никуда не сползает.

Добрый день!

Необходимо чтобы ListView не смещался.

Если так:
Me.ListView1.hWnd
то ошибка таже.

Так:
ListView1.hWnd - Compile error: Variable not defined

В примере не смещается. При определённом коде ListView может смещатся.
http://www.cyberforum.ru/vba/thread631436.html

Цитата:

Необходимо чтобы ListView не смещался.

Mishel917 лови свой переработанный файл: http://rghost.ru/39527436
Никакой функции не нужно.
Добавил переменную, которая запоминает название выбранной группы в момент нажатия кнопки мыши на ListView1, но до момента перехода на ListView2 и всё работает.
Скорее всего, это проблема перерисовки формы в Excel, потому что,если в твоём примере после нажатия на кнопку "Товарные груп." чуть-чуть передвинуть саму форму, то ListView1 становиться на своё место. Короче- глюк Excel.

Mishel917
У меня Ваш пример не открылся полностью, именно ListView потерялся. В приведённом мною выше примере использована другая библиотека, см. скрин. Хотя в последнее время я пользуюсь другими контролами, т.к. они поддерживают системное оформление. Выглядят они вот так. Если есть желание использовать - ссыль.

[more] psiho

Переменная, очевидно, может быть. Ещё есть смещения ListView2. Быстрые испытания показали, что переменная с высокой надёжностью устраняет 90% смещений. Оставшиеся смещения принадлежат ListView2. Если 10% не будут доставать пользователя, то код можно ставить на конвейер.

На смещение есть два мнения:
1. Глюк;
2. Фича, т. е. очевидно, так задумано – ListView стремится на своё место – в левый верхний угол формы.
После загрузки формы смещений нет. Для достижения 100% надёжности может на переходах в MultiPage удалять и прорисовывать ListView как то так?

Dim lwData As MSComctlLib.ListView

Set lwData = Me.MultiPage1.Pages(0).Controls.Add("MSComCtlLib.ListViewCtrl")

With lwData
.Name = "ListView1"
…
…
End With


Maximus777


Потеря ListView должна быть. Их необходимо установить из своего компьютера. У меня библиотека для ListView такая же – Micr. ListView Control v. 6.0. Новый Control я бы испытал, но не знаю, как его получить на форме VBA, синтаксис, название. Если Вы можете просветить ссылкой, например - то буду признателен.

Всем спасибо за участие в теме.

[/more]

Mishel917
Цитата:

Новый Control я бы испытал, но не знаю, как его получить на форме VBA, синтаксис, название. Если Вы можете просветить ссылкой, например - то буду признателен.

Элементарно. Открываете VBA-редактор, добавляете форму (или открываете уже с формами свой проект), открываете панель с инструментами (Toolbox), затем правая кнопка на свободном от контролов месте и выбираете Xtreme ... (их там куча). Вот Вам скрины в помощь:


Пример использования завтра могу закинуть. Дома Linux

Maximus777

На моём компьютере в списке Available Control нет Xtreme...

Mishel917
Цитата:

На моём компьютере в списке Available Control нет Xtreme...

Потому, что библиотеку *.ocx надо регистрировать в системе. Выше, в сообщении, есть ссылка на архив, там библы и батник, который копирует их в систему и регистрирует.

Парни, буду благодарен, если поможете мне решить одну простую задачку.
Имеется таблица в MS Excel. В таблице два основных столбца. "ФИО" и "Возраст". Каждый год, возраст, как это не печально, увеличивается на 1 год. В связи с тем, что я хочу менять возраст чаще чем раз в год, мне необходимо добавить в таблицу макрос-кнопку - "+1".
Чего я хочу:
По нажатию на кнопку- Все числа в определенном столбце возрастают на единицу.

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

Заранее спасибо -)

Вставте код в модуль листа и измените значения Row и Column на свои.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim intA As Integer
Dim myCell As Range

Set myCell = ActiveCell

For Each myCell In Selection
For intA = 5 To 54
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Cells(intA, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then

Cells(intA, 2) = Cells(intA, 2) + 1

End If
Next intA
Next myCell
End Sub

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

Mishel917
Тезка, Спасибо!, сделал, помогло, но не очень. Таблица в реале более сложная чем я описал. Я в ней постоянно работаю, и с уверенностью могу сказать, что точно случайно кликну в столбец не заметив этого. В итоге у меня получатся некорректные возраста.
Нужна кнопка. )

[more] Для кнопки на листе.

Private Sub CommandButton1_Click()
Dim myCell As Range
Dim intA As Integer

Dim Titl As String
Dim Prompt As String


Set myCell = ActiveCell

For intJ = 5 To 1005
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Worksheets("Ëèñò1").Cells(intJ, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then
If myCell <> "" Then
ActiveSheet.Cells(intJ, 2).Font.Color = vbBlue
Prompt = "Вы выбрали - " & "строка " & intJ & " значение " & ActiveSheet.Cells(intJ, 2) & Chr(13) & Chr(10) & "Продолжать ?"
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbYesNoCancel, Titl)
If intAns = vbYes Then GoTo 10
ActiveSheet.Cells(intJ, 2).Font.Color = vbBlack

ActiveSheet.Cells(4, 7).Activate
Exit Sub

10 ActiveSheet.Cells(intJ, 2).Font.Color = vbBlack
For Each myCell In Selection
For intA = 5 To 1005
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Cells(intA, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then

Cells(intA, 2) = Cells(intA, 2) + 1

End If
Next intA

Next myCell
Exit Sub
End If
Prompt = "Выделите курсором мыши номер."
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbInformation, Titl)
Exit Sub
End If
Next intJ
Prompt = "Выделите курсором мыши номер."
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbInformation, Titl)
End Sub

Необходимо добавить ещё больше сервиса, на случай выделения диапазона.

[/more]

Добавлено:
For intJ = 5 To 1005
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Worksheets("Лист1").Cells(intJ, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then

syd

Цитата:

Нужна кнопка. )

Дайте две :) А кнопка "-1", на случай неправильного увеличения? Тоже ведь нужна...
Нужна вызываемая миниформочка, в которой, применительно к выделению, можно указать знак и величину изменения (по дефолту +1).

grbdv
Чуваак, да ты зришь в корень, я просто не решился настолько усложнять задачу. )

Добавлено:

Цитата:

5 To 1005
      If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Worksheets("Лист1").Cells(intJ, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then

Сейчас попробую. Спасибо.

syd

Цитата:

Чуваак, да ты зришь в корень, я просто не решился настолько усложнять задачу. )

Я просто с обратной стороны начинаю решать :) С возможных проблем и хотелок, которые беспременно возникнут :)

syd
а если вставлять в столбец "Возраст" формулу:

Код: =ГОД(СЕГОДНЯ())-1970

syd
Держи рыбу :) Ее можно и нужно дорабатывать по нужде. Поверь - там подводных камней еще ого-го...

Процедуру Public Sub sb_UFCall() надо повесить на кнопку вызова.

http://rghost.net/private/39549317/264aa8595818cef5d9d42c087b1b5c09
Пароль стандартный

Maximus777

Спасибо, но повторюсь, в своей таблице я меняю возраст чаще чем раз в год.

syd
Цитата:

Спасибо, но повторюсь, в своей таблице я меняю возраст чаще чем раз в год.

Бедные сотрудники ... Зачем Вы их так обижаете?

grbdv

Чуваак, это круто. Спасибо.

Уважаю людей, способных на то, что я не умею)