У меня есть файла вида: 00000298.rpt, 00000299.rpt и так далее по порядку. В макросе хранится полный путь и имя файла. Как мне программно определить имя следующего файла?
» Excel VBA (часть 2)
Цитата:
Теперь в цикле обходит ячейки, но командой Find не чего не находит
У меня все работает.
Проверь на что ссылаются Worksheets(1) и Worksheets(2).
MORB_id
Цитата:
Зная полный путь файла получаешь с помощью функции Mid или Split его имя без расширения, приводише его к численному типу с помощью Val, прибавляешь единицу, с помощью Format дописываешь нули в начало и конкатенацией присоединяешь к пути и расширению.
Можно попробовать извернуться через регулярные выражения.
Но, наверное, целесообразнее будет использовать функцию Dir.
Цитата:
У меня есть файла вида: 00000298.rpt, 00000299.rpt и так далее по порядку. В макросе хранится полный путь и имя файла. Как мне программно определить имя следующего файла?
Зная полный путь файла получаешь с помощью функции Mid или Split его имя без расширения, приводише его к численному типу с помощью Val, прибавляешь единицу, с помощью Format дописываешь нули в начало и конкатенацией присоединяешь к пути и расширению.
Можно попробовать извернуться через регулярные выражения.
Но, наверное, целесообразнее будет использовать функцию Dir.
Цитата:
У меня есть файла вида: 00000298.rpt, 00000299.rpt и так далее по порядку. В макросе хранится полный путь и имя файла. Как мне программно определить имя следующего файла?
Возможно не совсем рационально, но можешь поробовать так...
Dim strFilName As String
Dim strA As String
strFilName = "00000999.rpt"
strA = Trim(Str(Val(Left(strFilName, 8)) + 1))
Set fs = Application.FileSearch
With fs
.LookIn = "C:\Reports"
.Filename = String(8 - Len(strA), "0") & strA & ".rpt"
If .Execute > 0 Then
MsgBox .FoundFiles(1)
Else
MsgBox "Нет такого файла!"
End If
End With
Добавлено:
ol7ca
Цитата:
Цитата:Имеем файл А - куда должны попасть даные из файлов В и С. Важно чтобы были вставлены только значения без формул а итоговые (последняя строка снизу и последний столбец справа) остались с формулами. спасибо.
кто-нибудь может мне помочь с написанием скрипта?
Вышли файлы А,В,С на master2_07@mail.ru. И опиши что ты хочешь!
Master_2007
Бедная ol7ca уже выложила эти файлы вот здесь
а
здесь комментарий по поводу файлов
я уже понял, что надо, но всё никак не собирусь помочь.
Да ещё проблема, ol7ca похоже выходит в инет очень редко, поэтому получается долгая перекличка. я вообще уже думал, что задача решена и уже ничего делать не надо, ан нет, похоже ошибся...
Бедная ol7ca уже выложила эти файлы вот здесь
а
здесь комментарий по поводу файлов
я уже понял, что надо, но всё никак не собирусь помочь.
Да ещё проблема, ol7ca похоже выходит в инет очень редко, поэтому получается долгая перекличка. я вообще уже думал, что задача решена и уже ничего делать не надо, ан нет, похоже ошибся...
есть вопрос.. как найти список используемых цветов?
"[Green]0.00%;[Red]-0.00%" какие ещё наименовани есть и как посмотреть весь список, для создания формата, без условного форматирования?
"[Green]0.00%;[Red]-0.00%" какие ещё наименовани есть и как посмотреть весь список, для создания формата, без условного форматирования?
SERGE_BLIZNUK
я не бедная а бедный-))
и в инете я частенько но по вечерам
а сообщений моих не много потому, что терпеливо жду помощи и не зужу-))
Master_2007
вам удалось посмотреть мои файлы и описание или лучше вам выслать?
я не бедная а бедный-))
и в инете я частенько но по вечерам
а сообщений моих не много потому, что терпеливо жду помощи и не зужу-))
Master_2007
вам удалось посмотреть мои файлы и описание или лучше вам выслать?
ol7ca
Цитата:
Цитата:
ну это похвально! Но зря. Если не дёргать за верёвочку, дверь не откроется...
Цитата:
а бедныйтысячу извинений... ник в заблуждение ввёл. сорри.
Цитата:
терпеливо жду помощи и не зужу
ну это похвально! Но зря. Если не дёргать за верёвочку, дверь не откроется...
SERGE_BLIZNUK
Цитата:
нет проблем-)
Цитата:
я же с просьбой обратился
кто-то тратит на меня свое свободное время
так что же мне торопить ... жду..
Цитата:
тысячу извинений... ник в заблуждение ввёл. сорри.
нет проблем-)
Цитата:
ну это похвально! Но зря. Если не дёргать за верёвочку, дверь не откроется...
я же с просьбой обратился
кто-то тратит на меня свое свободное время
так что же мне торопить ... жду..
Anton T
1) не качается Ваш файл
2) а что там - троянчик свежий или что?
1) не качается Ваш файл
2) а что там - троянчик свежий или что?
Добрый день, подскажите как при помощи макроса в экселе создать подготовить письмо для отправки по электронной почте, с вложением файла из которого создается письмо.
В продолжении темы
Код:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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 Const BM_CLICK = &HF5
Sub BtnClick()
Dim lhwnd As Long
Dim sClassName As String
Dim sCaption As String
sClassName = "ThunderRT6FormDC" ' класс окна
sCaption = "MyDialog" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
sClassName = "ThunderRT6CommandButton" ' класс кнопки
sCaption = "OK" ' заголовок кнопки
' Находим нужную кнопку в найденном окне
lhwnd = FindWindowEx(lhwnd, 0, sClassName, sCaption)
' Посылаем кнопке событие BM_CLICK
SendMessage lhwnd, BM_CLICK, 0, 0
End Sub
Код:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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 Const BM_CLICK = &HF5
Sub BtnClick()
Dim lhwnd As Long
Dim sClassName As String
Dim sCaption As String
sClassName = "ThunderRT6FormDC" ' класс окна
sCaption = "MyDialog" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
sClassName = "ThunderRT6CommandButton" ' класс кнопки
sCaption = "OK" ' заголовок кнопки
' Находим нужную кнопку в найденном окне
lhwnd = FindWindowEx(lhwnd, 0, sClassName, sCaption)
' Посылаем кнопке событие BM_CLICK
SendMessage lhwnd, BM_CLICK, 0, 0
End Sub
SERGE_BLIZNUK
1) надо сначала открывать сайт, а не программа закачек, потом дальше "Скачать файл: ... " вот, пример, http://files.people.overclockers.ru/AntonT/Gener_pwd.rar
2) там ничего нету, простоват.
1) надо сначала открывать сайт, а не программа закачек, потом дальше "Скачать файл: ... " вот, пример, http://files.people.overclockers.ru/AntonT/Gener_pwd.rar
2) там ничего нету, простоват.
Olive77
Цитата:
Попробуй что то типа этого:
Код: Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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 Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Const WM_SETTEXT = &HC
Private Const GW_HWNDNEXT = 2
Sub FillInTextBoxes()
Dim lhwnd As Long
Dim sClassName As String
Dim sCaption As String
sClassName = "ThunderRT6FormDC" ' класс окна
sCaption = "MyDialog" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
sClassName = "ThunderRT6TextBox" ' класс текстового поля
' Находим текстовое поле в найденном окне
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "first"
' Находим следующее дочернее окно
lhwnd = GetNextWindow(lhwnd, GW_HWNDNEXT)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "second"
' Находим следующее дочернее окно
lhwnd = GetNextWindow(lhwnd, GW_HWNDNEXT)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "third"
End Sub
Цитата:
А вот вариант с посыланием текста в TextBox что-то не проходит.
В диалоговом окне присутствуют 3 TextBoxа.
В интернете нашел, что надо сначала определить первый TextBox, через него второй, и т.д. Кто-то пишет, что порядок нахождения обратный.
В-общем, попробывал и так и этак. Ничего не проходит, а в одном случае даже Excel вылетает.
Попробуй что то типа этого:
Код: Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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 Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Const WM_SETTEXT = &HC
Private Const GW_HWNDNEXT = 2
Sub FillInTextBoxes()
Dim lhwnd As Long
Dim sClassName As String
Dim sCaption As String
sClassName = "ThunderRT6FormDC" ' класс окна
sCaption = "MyDialog" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
sClassName = "ThunderRT6TextBox" ' класс текстового поля
' Находим текстовое поле в найденном окне
lhwnd = FindWindowEx(lhwnd, 0, sClassName, vbNullString)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "first"
' Находим следующее дочернее окно
lhwnd = GetNextWindow(lhwnd, GW_HWNDNEXT)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "second"
' Находим следующее дочернее окно
lhwnd = GetNextWindow(lhwnd, GW_HWNDNEXT)
SendMessage lhwnd, WM_SETTEXT, 0&, ByVal "third"
End Sub
Подскажите плиз как надо сделать:
Обрабатывается таблица (для примера только 2 поля)
--------------------------------
Option Base 1
Option Explicit
Type BaseA
Дата As Date
Сумма As Double
End Type
Dim Base() As BaseA
далее код программы в процессе которой создается массив.
В табличном виде выглядит так:
Дата Сумма
01.01.2007 100
01.02.2007 200
01.01.2007 150
01.03.2007 300
В конечном счете надо получить таблицу:
Дата Сумма
01.01.2007 250
01.02.2007 200
01.03.2007 300
Итак, есть массив
Base(i).Дата=01.01.07
Base(i).Сумма=100
ит.д.
Public Sub SumToBase()
Dim BaseSum As Variant
Dim Find_k As Variant
ReDim BaseSum(КолЗап)
k = 0
For i = 1 To КолЗап
k = k + 1
Find_k = False
If i = 1 Then
BaseSum(k).Дата = Base(i).Дата
BaseSum(k).Сумма = Base(i).Сумма
Else
For j = 1 To k - 1
If Base(i).Дата = BaseSum(k).Дата Then
BaseSum(k).Сумма = BaseSum(k).Сумма+ Base(i).Сумма
Find_k = True 'признак что запись с такой датой найдена
k = k - 1
Exit For
End If
Next j
If Find_k = False Then
BaseSum(k).Дата = Base(i).Дата
BaseSum(k).Сумма = Base(i).Сумма
End If
End If
Next i
If Find_k = True Then
k = k - 1
End If
End Sub
т.е. есть таблица, она обрабатывается, получается массив, где есть одинаковые данные. Затем в другом массиве одинаковые данные суммируются; создается 3 массив, где данные трансформируются для экспорта в таблицу и экспортируются
Selection.Value = Base_Tmp
До создания массива с суммированием все работало. Что еще где надо подправить - не пойму
Обрабатывается таблица (для примера только 2 поля)
--------------------------------
Option Base 1
Option Explicit
Type BaseA
Дата As Date
Сумма As Double
End Type
Dim Base() As BaseA
далее код программы в процессе которой создается массив.
В табличном виде выглядит так:
Дата Сумма
01.01.2007 100
01.02.2007 200
01.01.2007 150
01.03.2007 300
В конечном счете надо получить таблицу:
Дата Сумма
01.01.2007 250
01.02.2007 200
01.03.2007 300
Итак, есть массив
Base(i).Дата=01.01.07
Base(i).Сумма=100
ит.д.
Public Sub SumToBase()
Dim BaseSum As Variant
Dim Find_k As Variant
ReDim BaseSum(КолЗап)
k = 0
For i = 1 To КолЗап
k = k + 1
Find_k = False
If i = 1 Then
BaseSum(k).Дата = Base(i).Дата
BaseSum(k).Сумма = Base(i).Сумма
Else
For j = 1 To k - 1
If Base(i).Дата = BaseSum(k).Дата Then
BaseSum(k).Сумма = BaseSum(k).Сумма+ Base(i).Сумма
Find_k = True 'признак что запись с такой датой найдена
k = k - 1
Exit For
End If
Next j
If Find_k = False Then
BaseSum(k).Дата = Base(i).Дата
BaseSum(k).Сумма = Base(i).Сумма
End If
End If
Next i
If Find_k = True Then
k = k - 1
End If
End Sub
т.е. есть таблица, она обрабатывается, получается массив, где есть одинаковые данные. Затем в другом массиве одинаковые данные суммируются; создается 3 массив, где данные трансформируются для экспорта в таблицу и экспортируются
Selection.Value = Base_Tmp
До создания массива с суммированием все работало. Что еще где надо подправить - не пойму
Подскажите, пожалуйста, что я делаю не так:
Private Sub CommandButton2_Click()
ThisWorkbook.UpdateLinks
End Sub
Пишет, что Inbalid use of propety
Private Sub CommandButton2_Click()
ThisWorkbook.UpdateLinks
End Sub
Пишет, что Inbalid use of propety
Ronya14
ThisWorkbook.UpdateLinks - есть свойство
тебе надо, по-видимому, использовать UpdateLink
Выдаляем ключевое слово, нажимаем F1 и читаем помощь
Troitsky
В-общем, оказалось, что нужный мне TextBox является не третьим, а вторым.
Но, проблема еще не решена.
После нажимания кнопки "OK", появляется сообщение, что типа все в порядке, ошибок при преобразовании не было. Тут тоже надо нажать на "OK".
НО,
для нажатия на первую "OK", я применял Application.OnTime Now() + TimeValue("00:00:03"), "BtnClick".
Во втором случае это не проходит. Никакие макросы не выполняются пока не нажму на кнопку "OK" во втором диал. окне.
Попробывал скомпилировать небольшую ехешку, которая через регулярные интервалы проверяет, появилось ли это диалоговое окно или нет, но она ничего не находит.
У этого диалогового окна, window class - #32770 (Inqsof Window Scanner)
Что можно еще попробывать?
ThisWorkbook.UpdateLinks - есть свойство
тебе надо, по-видимому, использовать UpdateLink
Выдаляем ключевое слово, нажимаем F1 и читаем помощь
Troitsky
В-общем, оказалось, что нужный мне TextBox является не третьим, а вторым.
Но, проблема еще не решена.
После нажимания кнопки "OK", появляется сообщение, что типа все в порядке, ошибок при преобразовании не было. Тут тоже надо нажать на "OK".
НО,
для нажатия на первую "OK", я применял Application.OnTime Now() + TimeValue("00:00:03"), "BtnClick".
Во втором случае это не проходит. Никакие макросы не выполняются пока не нажму на кнопку "OK" во втором диал. окне.
Попробывал скомпилировать небольшую ехешку, которая через регулярные интервалы проверяет, появилось ли это диалоговое окно или нет, но она ничего не находит.
У этого диалогового окна, window class - #32770 (Inqsof Window Scanner)
Что можно еще попробывать?
Olive77
А вот это в качестве задержки будет работать или нет?
Код: MsgBox "Sub will run after 10 seconds!"
Application.OnTime Now + TimeValue("00:00:10"), "my_Procedure"
А вот это в качестве задержки будет работать или нет?
Код: MsgBox "Sub will run after 10 seconds!"
Application.OnTime Now + TimeValue("00:00:10"), "my_Procedure"
Здравствуйте.
Подскажите, плиз, как выделить диапазон, который получился после применения автофильтра?
Пример данных:
А1 В1 С1
Дата Наименование Количество
01.01.2007 Шланг 2
02.01.2007 Колодка 1
02.01.2007 РК 5
05.01.2007 РК 2
06.01.2007 Фильтр 1
07.01.2007 Шланг 3
09.01.2007 Колодка 2
12.01.2007 Шланг 4
15.01.2007 РК 3
S1 = CStr(InputBox("Наименование:")) 'вводим наименование
Selection.AutoFilter Field:=2, Criteria1:=S1 'срабатывает автофильтр по введенному критерию.
Повторю вопрос: как выделить диапазон, который получился после применения автофильтра, чтобы с ним дальше можно было работать?
Подскажите, плиз, как выделить диапазон, который получился после применения автофильтра?
Пример данных:
А1 В1 С1
Дата Наименование Количество
01.01.2007 Шланг 2
02.01.2007 Колодка 1
02.01.2007 РК 5
05.01.2007 РК 2
06.01.2007 Фильтр 1
07.01.2007 Шланг 3
09.01.2007 Колодка 2
12.01.2007 Шланг 4
15.01.2007 РК 3
S1 = CStr(InputBox("Наименование:")) 'вводим наименование
Selection.AutoFilter Field:=2, Criteria1:=S1 'срабатывает автофильтр по введенному критерию.
Повторю вопрос: как выделить диапазон, который получился после применения автофильтра, чтобы с ним дальше можно было работать?
Цитата:
А вот это в качестве задержки будет работать или нет?
Код:
Код: MsgBox "Sub will run after 10 seconds!"
Application.OnTime Now + TimeValue("00:00:10"), "my_Procedure"
P.S. Должна быть Sub с именем my_Procedure, которая вызывается через указанное время.
Цитата:
Повторю вопрос: как выделить диапазон, который получился после применения автофильтра, чтобы с ним дальше можно было работать?
попробуй
Range(strAdress).SpecialCells(xlCellTypeVisible)
Master_2007
вам удалось посмотреть мои файлы и описание или лучше вам выслать?
вам удалось посмотреть мои файлы и описание или лучше вам выслать?
Ребята подскажите как написать макрос.
Есть 128 файлов ексель с калькуляциями (1,2,3...128).
Нужно свести ети файлы в один файл, так что каждая калькуляция была на отдельном листе(1,2.....128)
Еще один вопрос
Как c помощю Макроса разорвать все связи в Excel?
Есть 128 файлов ексель с калькуляциями (1,2,3...128).
Нужно свести ети файлы в один файл, так что каждая калькуляция была на отдельном листе(1,2.....128)
Еще один вопрос
Как c помощю Макроса разорвать все связи в Excel?
Olive77
А у второго заработало через EXE?
А у второго заработало через EXE?
нет, пока не было времени этим заняться 
Свой вопрос решил так:
Application.ScreenUpdating = False
Dim filenumber As String
For fnum = 68 To 128
sname = CStr(fnum)
Workbooks.Open Filename:="D:\temp\....\" & (sname) & ".xls", _
UpdateLinks:=0
Sheets("ìàòåð³àëè").Select
Cells.Copy
Windows("all.XLS").Activate
Sheets("" & (sname) & "").Select
Cells.Select
ActiveSheet.Paste
Windows("" & (sname) & ".XLS").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close
Windows("all.XLS").Activate
Next fnum
но нужно теперь еще подчистить листи от спрятаных строк, строки могут быть просто спрятаны или спрятаны плюсиком.
Ребята помогите, как ето сделать, так как не хочу делать ето вручную
Application.ScreenUpdating = False
Dim filenumber As String
For fnum = 68 To 128
sname = CStr(fnum)
Workbooks.Open Filename:="D:\temp\....\" & (sname) & ".xls", _
UpdateLinks:=0
Sheets("ìàòåð³àëè").Select
Cells.Copy
Windows("all.XLS").Activate
Sheets("" & (sname) & "").Select
Cells.Select
ActiveSheet.Paste
Windows("" & (sname) & ".XLS").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close
Windows("all.XLS").Activate
Next fnum
но нужно теперь еще подчистить листи от спрятаных строк, строки могут быть просто спрятаны или спрятаны плюсиком.
Ребята помогите, как ето сделать, так как не хочу делать ето вручную
Цитата:
попробуй
Range(strAdress).SpecialCells(xlCellTypeVisible)
Не работает
Вот это работает
Set myFiltered = ActiveSheet.AutoFilter.Range.Offset(1, 0).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1, _
ActiveSheet.AutoFilter.Range.Columns.Count).SpecialCells(xlCellTypeVisible)
myFiltered.Select
Цитата:
попробуй
Range(strAdress).SpecialCells(xlCellTypeVisible)
Цитата: Не работает
Olive77
Цитата:
Трудно рассуждать о том, что можно попробовать еще, не видя того, что есть сейчас. Запостил бы под more листинг с комментариями что где происходит и какого результата какой строчкой хочешь добиться. Было бы не плохо "пощупать" и предмет обсуждения - есть возможность выложить документ со всеми прибамбасами, о которых речь идет?
Добавлено:
Olive77
Цитата:
Кстати, обрати внимание, что ежели система русская, то и заголовок кнопки "ОК" в диалоге, скорее всего, в русском написании идет, а, следовательно, при поиске окна с англоязычным заголовком, ты кнопку просто не найдешь - функция FindWindowEx будет ноль возвращать
Цитата:
После нажимания кнопки "OK", появляется сообщение, что типа все в порядке, ошибок при преобразовании не было. Тут тоже надо нажать на "OK".
<...>
Что можно еще попробывать?
Трудно рассуждать о том, что можно попробовать еще, не видя того, что есть сейчас. Запостил бы под more листинг с комментариями что где происходит и какого результата какой строчкой хочешь добиться. Было бы не плохо "пощупать" и предмет обсуждения - есть возможность выложить документ со всеми прибамбасами, о которых речь идет?
Добавлено:
Olive77
Цитата:
Никакие макросы не выполняются пока не нажму на кнопку "OK"
Кстати, обрати внимание, что ежели система русская, то и заголовок кнопки "ОК" в диалоге, скорее всего, в русском написании идет, а, следовательно, при поиске окна с англоязычным заголовком, ты кнопку просто не найдешь - функция FindWindowEx будет ноль возвращать
Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133
Предыдущая тема: Написание своего HyperTerminal для считывания данных
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.