» Excel VBA

Праздники прошли...
Попытаю счастья еще раз...
Каким образом подставить данные с определенного поля(Счет номер...) в диалог сохранинеия файла, а точнее как имя файла? Документ перед этим сохранять нельзя.

The okk

Цитата:

FileFormat := xlTextWindows (Текстовые файлы с разделителями табуляции)

Тогда сохраняется не текст, а кракозябры. Версия EXCELа - англицкая

Добавлено:
SERGE_BLIZNUK
Весь текст выглядит так

Цитата:

"рус 717,424,640 avi 01 я купил папу"
"рус 3,664,581,648 avi 10 я не вернусь"
"рус 729,561,088 avi 01 я обьявляю вам войну"
"рус 722,585,600 avi 01 я русский солдат"
"рус 3,652,987,456 avi 10 я тебя люблю"
"рус 735,672,320 avi 01 я тебя обожаю"
"рус 767,226,768 mpg 01 я шагаю по москве"

vzbzdnov
Другими словами, надо выгрузить плэйлист из xls в txt? Или другой формат файла тоже подойдет? Просто у меня проблем никаких не возникает. Даже в Юникод выгружаю - никаких проблем. Табуляцию ставит нормально, никаких лишних кавычек.

WWWovan

Цитата:

Каким образом подставить данные с определенного поля(Счет номер...) в диалог сохранинеия файла, а точнее как имя файла?

Код: Application.GetSaveAsFilename InitialFileName:=Cells(1, 1)

WWWovan

вот так вот вышло примерно. комменты лень писать


Код: Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim bFirstSave As Boolean
Dim sInitialFileName As String
Dim vReturnedName As Variant

bFirstSave = ThisWorkbook.Path = ""

If bFirstSave Then
sInitialFileName = "êíèãà-ñ÷åò " & CStr(ActiveSheet.Range("b2").Value)
vReturnedName = Application.GetSaveAsFilename(InitialFileName:=sInitialFileName, _
fileFilter:="excel (*.xls), *.xls")

If vReturnedName <> False Then

Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=vReturnedName
Application.EnableEvents = True

End If

Cancel = True
End If

End Sub

Кто-нибудь, вставьте в шапку ссылку Daily Dose of Excel. Там полезные вещи периодически пишут. Вчера, например, писали, как в листбоксе менять местами элементы перетаскиванием (DragDrop).

to SERGE_BLIZNUK

Цитата:

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

Абсолютно с вами согласен. Но, к сожалению, создание кода выходит за рамки моих возможностей. Увы...

The okk просто маленький комментарий к вчерашней фразе...

Цитата:

Он должен быть открыт (если и должен), только когда ты меняешь ссылку.

Это не так.
=ДВССЫЛ о котором речь шла выше, требует открытой книги (из хелпа):

Цитата:

Если ссылка_на_ячейку является ссылкой на другую рабочую книгу (внешней ссылкой), другая рабочая книга должна быть открытой. Если это не так, функция ДВССЫЛ возвратит значение ошибки #ССЫЛКА!.

vzbzdnov

Цитата:

"рус 717,424,640 avi 01 я купил папу"

как я понял, в Excel кавычек нет - они появляются при сохранении в файл?
попробуйте такой макрос:
Код:
Sub WriteToFileTXT()
Open "C:\Test1.txt" For Output As 1
Row1 = ActiveWorkbook.ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
MsgBox "Сохраняем строки от " & Str(Row1) & " до " & Str(Row2) & _
" в файл C:\Test1.txt"
For I = Row1 To Row2
Print #1, Cells(I, 1).Value
Next I

Close 1 ' Закроем файл

End Sub

Кто-нибудь знает, где в текстбоксе задается шаблон (если он вообще задается)?
Надо сделать ##.##.#### (dd.mm.yyyy)
Или подскажите какой-нибудь похожий контрол, позволяющий задавать шаблоны. Наверняка такой есть. А то лень велосипед изобретать.

Друзья,
мне помогли с решением моей задачи
Вот решение:

P.S.Может кому понадобится

ZORRO2005
Посмотрел. Имена диапазонов и использование формул массивов ({}) - вообще сильная штука. Я их недооценивал. Надо будет обязательно изучить.

ZORRO2005
Цитата:

Вот решение

Решение красивое! Спасибо, что не поленились поделиться с нами..
А столбец D как обновлять - ручками?
При использовании учтите, что ОБЯЗАТЕЛЬНА сортировка в FG !!

SERGE_BLIZNUK

Цитата:

При использовании учтите, что ОБЯЗАТЕЛЬНА сортировка в FG

Для чего?

---

Нашел среди дополнительных контролов массу полезных. Например, календарь (а я уж было его руками делать собрался), причем весьма цивильный и без багов (что для мелко-мягкого вообще фантастика!).
Нашел нужный мне контрол (TextBox с маской) - зовется Microsoft Masked Edit Control. Полезнейшая штука! Только ошибку выдает при попытке его выложить на форму. Видите ли, с лицензией проблемы.
У кого-нибудь он нормально на форму выкладывается?
Microsoft SpreadSheet Control - добавляет на форму подобие листа Excel! Красиво.

The okk
Цитата:

Цитата: При использовании учтите, что ОБЯЗАТЕЛЬНА сортировка в FG

Для чего?

SERGE_BLIZNUK спасибо большое работает!
но иногда бывают 3,2 значные числа, а в шеснатеричном формате надо что бы было всегда по 4 цифры с двух колонок.
привожу код что бы не искать

Код: Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+n
'
ColumnOfDigit1 = 3 ' константа - номер столбца с первым числом
ColumnOfDigit2 = 4 ' константа - номер столбца со вторым числом
ColumnOfMainText = 11 ' константа - номер столбца с текстом
Row1 = ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveSheet.UsedRange.Rows.Count - 1
For i = Row1 To Row2
Workbooks("Книга2").Worksheets("Лист1").Cells(i, 1).Value = _
Hex(Cells(i, ColumnOfDigit1).Value) + Hex(Cells(i, ColumnOfDigit2).Value) + "25002"
Workbooks("Книга2").Worksheets("Лист1").Cells(i, 2).Value = _
Cells(i, ColumnOfMainText).Value
Next i
End Sub

SERGE_BLIZNUK прав,
надо обязательно сортировать FG

ZORRO2005
Спасибо за решение. Красиво. Я и забыл, что при наименовании диапазона можно тоже формулу использовать.

The okk

Цитата:

Другими словами, надо выгрузить плэйлист из xls в txt? Или другой формат файла тоже подойдет? Просто у меня проблем никаких не возникает. Даже в Юникод выгружаю - никаких проблем. Табуляцию ставит нормально, никаких лишних кавычек

Ну, вроде того. Какой другой формат? Хотелось бы, чтоб в конце получился простой текстовый файл. Если у тебя такое работает, то как ты это делпаешь? И какой EXCEL - английский или русский?

vzbzdnov
восьмью постами выше я вами написал программку выгрузки в текстовый файл. Она работает?

ghost3k

Цитата:

добавить в лист/книгу НАПОМИНАНИЕ?
Что бы срабатывало при открытии Excel. Например, напоминание изменить в книге/листе что либо

Так всё таки при открытии книги, или при открытии Excel ?
Если книги, то в WorkBook_Open :
Код:
Private Sub Workbook_Open()
MsgBox "Исправь начисления на втором листе!"
End Sub

SERGE_BLIZNUK

Цитата:

я вами написал программку выгрузки в текстовый файл. Она работает?

Спасибо, работает!!!!

Можно ли открывать файлы в одной процедуре, а писать в них в других? Как в этом случае передать номер файла?
Мне надо сделать
Open "Test1.txt" For Output As 1
Open "Test2.txt" For Output As 2
Open "Test3.txt" For Output As 3
в главной процедуре а писать в них из многих процедур. Как передать номер файла? И нужно ли вообще передавать? Т.е. если команда Print #1, txt стоит в другой процедуре, то нужно ли этот самый #1 как-то передать, или и так сработает?

vzbzdnov
Цитата:

в главной процедуре а писать в них из многих процедур. Как передать номер файла? И нужно ли вообще передавать? Т.е. если команда Print #1, txt стоит в другой процедуре, то нужно ли этот самый #1 как-то передать, или и так сработает?

Ая-яй... А неужели проверить сложно? я вот тоже не знаю, как оно в теории будет, но, проверил - в одной процедуре делаешь open.. as 2
в другой - print #2 (причём вызывал её несколько раз)
на закрытие книги - Close #2
всё работает...

Столкнулся с интересной задачей. Есть ячейки формата ##/##. Надо, чтобы число после знака дроби было выделено (например, цветом или шрифтом). Это вообще возможно сделать? Понимаю, что "в лоб" решить не получится, поскольку у ячейки шрифт только 1. Но все-таки наверняка есть обходной маневр...

А, все, решил - в общем, делаем две ячейки вместо одной. В первой остается вся левая часть + знак дроби (т.е. ##/), во вторую выносим число после дроби (##). С первой ячейкой ничего не делаем, во второй ставим нужный формат текста и выравнивание по левому краю. Убираем линии сетки и рисуем границу вокруг двух этих ячеек.
Вуаля - на вид имеем одну ячейку с выделенным правым числом.

The okk вы правильно сделали, что нашли обходной маневр, но, не могу оставить вас в неведении ;-))
Цитата:

поскольку у ячейки шрифт только 1.

это не так: выделите в строке формул ЧАСТЬ строки и выберите другой шрифт, начертание (жирный, наклонный), размер, цвет...
получится вот так, например,

SERGE_BLIZNUK
Я пробовал. Но в итоге все форматирование пропадет, когда ячейка станет неактивной. Останется формат, который задан в "Формат ячейки".

The okk
Здарова! Я не знаю как отфильтровать в ListView?
[more=Здесь коды]
Код: Private Sub txtFiltBox_Change()
Dim rng As Range
Dim r As Range
Dim strFilt As String
Dim strFiltLen As Integer
Dim arrFilt As Variant 'динамический массив
Dim ColCnt As Integer
Dim i As Integer, c As Integer

ColCnt = ActiveSheet.UsedRange.Columns.Count
Set rng = ActiveSheet.UsedRange
strFilt = txtFiltBox.Text
strFiltLen = Len(strFilt)
i = 0
ReDim arrFilt(ColCnt - 1, i)

For Each r In rng.Rows
If strFilt = Left(r.Cells(1.1).Text, strFiltLen) Then
ReDim Preserve arrFilt(ColCnt - 1, i)
For c = 1 To ColCnt
arrFilt(c - 1, i) = r.Cells(1, c).Value
Next
i = i + 1
End If
Next
ListView1 = arrFilt
End Sub

Private Sub txtFiltBox_Enter()
With txtFiltBox
.BackColor = RGB(205, 236, 253)
.Font.Bold = True
End With
End Sub

Private Sub txtFiltBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With txtFiltBox
.BackColor = RGB(255, 255, 255)
.Font.Bold = False
End With
End Sub

Private Sub UserForm_Initialize()
Dim RowCounter As Long
Dim ls As Worksheet

With ListView1 'и в ListView
.ColumnHeaders.Add , , "Фамилия", 75 'Фамилия
.ColumnHeaders.Add , , "Имя", 60 'Имя
.ColumnHeaders.Add , , "Отечество", 70 'Отечество
.ColumnHeaders.Add , , "Город", 45 'Город
.ColumnHeaders.Add , , "Адрес", 115 'Адрес
.ColumnHeaders.Add , , "дом", 30 'Дом
.ColumnHeaders.Add , , "кв.", 30 'Квартира
.ColumnHeaders.Add , , "Книга 1", 40 'Кинга 1
.ColumnHeaders.Add , , "Книга 2", 40 'Книга 2
.ColumnHeaders.Add , , "Страница", 50 'Страница
.ColumnHeaders.Add , , "Реестр №", 50 'Реестровый номер
.Gridlines = True 'рисуем сетку (ибо удобно!)
.View = lvwReport 'выводить отсчета

For Each ls In Worksheets 'в каждом листе
For RowCounter = 1 To ls.UsedRange.Rows.Count 'проходим по всем строкам
With .ListItems
.Add = ls.Cells(RowCounter, 1) 'добавляем элемент (Фамилию)
.Item(.Count).SubItems(1) = ls.Cells(RowCounter, 2) 'и его подэлементы (Имя)
.Item(.Count).SubItems(2) = ls.Cells(RowCounter, 3) 'Отечество
.Item(.Count).SubItems(3) = ls.Cells(RowCounter, 4) 'Город
.Item(.Count).SubItems(4) = ls.Cells(RowCounter, 5) 'Адрес
.Item(.Count).SubItems(5) = ls.Cells(RowCounter, 6) 'Дом
.Item(.Count).SubItems(6) = ls.Cells(RowCounter, 7) 'Квартира
.Item(.Count).SubItems(7) = ls.Cells(RowCounter, 8) 'Книга 1
.Item(.Count).SubItems(8) = ls.Cells(RowCounter, 9) 'Книга 2
.Item(.Count).SubItems(9) = ls.Cells(RowCounter, 10) 'Страница
.Item(.Count).SubItems(10) = ls.Cells(RowCounter, 11) 'Реестр №
End With
Next
Next
End With

End Sub

Anton T
Привет.
ListView1 = arrFilt - это, если не ошибаюсь, попытка записать в выделенный элемент ListView1 (кажется, такое у него свойство по умолчанию) многомерный массив.
В одно действие многомерный массив в многомерный ListView не прописывается, поскольку он по сути состоит из двух массивов: одномерного массива элементов ListItems и многомерного массива подэлементов SubItems (или, в виде коллекции, ListSubItems). Если оперировать только с ListItems, 100% вероятность потери подэлементов.
Ты хочешь, чтобы при изменении текстбокса с критерием фильтрации (первыми буквами фамилии), немедленно осуществлялась фильтрация по ListView1. Причем, не просто фильтрация (скрытие элементов), а вырезание всех, не попадающих под критерий, элементов?
Или в ListView должны попасть все записи с активного листа, удовлетворяющие условию текстбокса?

The okk
Цитата:

Я пробовал. Но в итоге все форматирование пропадет, когда ячейка станет неактивной. Останется формат, который задан в "Формат ячейки".

буду нудным.. а что означает - станет неактивной? У меня вроде всё работает...

что я делаю не так? ;-)))

На листе 1 есть данные. Выделяем этот диапазон с данными и копируем его на лист2. Написала код, но он не работет. Кто подскажет, где ошибка. Вот код:

Sub копирование_диапазона()

Dim d As Variant
Dim a As Variant
Dim k As Variant
Dim b1 As Variant
Dim b2 As Variant

Set b1 = ThisWorkbook.Worksheets("Лист1") 'на этом листе находятся данные
Set b2 = ThisWorkbook.Worksheets("Лист2") 'лист на который копировать данные

d = b1.UsedRange.Rows.Count 'выделенный диапазон значений

b1.Activate

k = 1

For a = 1 To d

Range(Cells(a, 1), Cells(a, 2)).Value.Copy b2.Range(Cells(k, 1), Cells(k, 2)).Value

k = k + 1

Next

b2.Activate

End Sub

The okk

Цитата:

Ты хочешь, чтобы при изменении текстбокса с критерием фильтрации (первыми буквами фамилии), немедленно осуществлялась фильтрация по ListView1.

Да

Цитата:

ричем, не просто фильтрация (скрытие элементов), а вырезание всех, не попадающих под критерий, элементов?

Как получиться.

Цитата:

Или в ListView должны попасть все записи с активного листа, удовлетворяющие условию текстбокса?

Да.

Добавлено:
Pantera3587
Юмористь!
Сейчас дам код.

SERGE_BLIZNUK

Цитата:

что я делаю не так?

Используешь версию 2003

Pantera3587

Код:
Sub Copy_Range()
Dim lRowsCount As Long, lColCount As Long

'работаем с листом1
With Worksheets("Лист1")
'определяем количество используемых строк
lRowsCount = .UsedRange.Rows.Count
'и столбцов
lColCount = .UsedRange.Columns.Count
'в диапазон первого листа, совпадающий по размеру с
'используемым диапазоном первого листа записываем
'весь используемый диапазон первого листа
Worksheets("Лист2").Range(Cells(1, 1), _
Cells(lRowsCount, lColCount)) = .UsedRange
End With

End Sub