» Excel VBA (часть 3)

ZlydenGL
Работает вот так
Open ActiveWorkbook.Path & "\log_report.txt" For Append As #1
Print #1, "Файл " & ActiveWorkbook.Name & " успешно отправлен " & Now()
Close #1

привет. Необходимо скопировать несколько диапазонов в цикле с одного листа на другой. Как реализовать?
Вот кусок моего кода:
i = 1
k = 2
j = 4
With Worksheets("Sh1")
Do While .Cells(j, i) <> ""
If .Cells(j, i).Value >= min And .Cells(j, i).Value <= max Then
.Range(Cells(j, 2), Cells(j, 15)).Copy _
Destination:=Worksheets("Sh2").Range(Cells(k, 1)) 'Тут выдает ошибку.
k = k + 1:
End If:
j = j + 1
Loop
End With

Вместо
Код: Worksheets("Sh2").Range(Cells(k, 1))

proffesor00
Код: .Range(Cells(j, 2), Cells(j, 15)).Copy _
Destination:=Worksheets("Sh2").Cells(k, 1)

Добрый день!
Специалисты, помогите, пожалуйста с макросом.
Суть: на входе есть куча .xls, которые имеют внутри 1 лист с данными и называются по принципу name_20101216.xls
на выходе хочется автоматически пересохранять все файлы .xls в DBF 3 файлы присваивая DBFкам имена исходных .xls (т.е. был name_20101216.xls, стал name_20101216.dbf)

В самом идеальном случае, конечно, хочется средствами Excel и VBA экспортировать данные из многих .xls в единую базу в формате DBF (пока не знаю, насколько это возможно).

Пробегаюсь по всем файлам с помощью:
Dim MainDir, FName() As String

MainDir = ActiveWorkbook.Path & "\"
ReDim FName(1)
FName(1) = Dir(MainDir & "*.xls")

k = 2
While (FName(k - 1) <> "")
ReDim Preserve FName(k)
FName(k) = Dir()
k = k + 1
Wend
k = k - 2
If (k > 0) Then
For i = 1 To k
If (UCase(FName(i)) <> UCase(ThisWorkbook.Name)) Then
f_name = MainDir & FName(i)
Workbooks.Open Filename:=MainDir & FName(i)
Windows("Mod.xls").Activate
Range("AF2").Select
Sheets("Head").Select
...
ActiveWorkbook.Save
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False

End If
Next i
End If

С этим проблем нет, но никак не могу сохранить в формате DBF с нужными именами...

Sale525
AFile_Name = AFile_Name = ActiveWorkbook.FullName
iBaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(AFile_Name)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & iBaseName & ".dbf", _
FileFormat:=xlDBF4, CreateBackup:=False

mcdie, спасибо за отклик!

"Затык" продолжается. Все глохнет на этом:


Цитата:

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & iBaseName & ".dbf", _
FileFormat:=xlDBF4, CreateBackup:=False

Вываливается Run-time error "1004"

При этом в папке появляется новый файл False.dbf

В целом код выглядит следующим образом:

Цитата:

Sub Modify()
Dim MainDir, FName() As String

MainDir = ActiveWorkbook.Path & "\"
ReDim FName(1)
FName(1) = Dir(MainDir & "*.xls")

k = 2
While (FName(k - 1) <> "")
ReDim Preserve FName(k)
FName(k) = Dir()
k = k + 1
Wend
k = k - 2
'MsgBox MainDir
'MsgBox (k) '' Workbook truncate

If (k > 0) Then
For i = 1 To k
If (UCase(FName(i)) <> UCase(ThisWorkbook.Name)) Then
f_name = MainDir & FName(i)
Workbooks.Open Filename:=MainDir & FName(i)
Windows("Mod.xls").Activate
Range("AF2").Select
Sheets("Head").Select
Range("A1:Q2").Select
Selection.Copy
' Переключаемся на обрабатываемый файл
Workbooks(FName(i)).Activate
' Вставляем "шапку"
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Сохраняем
AFile_Name = AFile_Name = ActiveWorkbook.FullName
iBaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(AFile_Name)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & iBaseName & ".dbf", _
FileFormat:=xlDBF4, CreateBackup:=False

End If
Next i
End If

End Sub

Привет всем.
Такое вот дело, не знаю, туда ли я с вопросом.
есть вообщем скрипт для автоматизацмм работы в SAP написанный с помошью самого SAP через SAP Gui scripting.
Сутьт скрипта заключается в том, что он обрабатывает список документов, каждый док - двойная обработка. И при работе скрипта, необходимо ставить паузу в определенном месте в пару тройку секунд. После 15 строчки.

вот само тело скрипта.


Цитата:

IsInput    ID    ScriptCode
START    001    
    002    MySession.findById("wnd[0]").resizeWorkingPane 107,27,false
x    003    MySession.findById("wnd[0]/usr/ctxtLIKP-VBELN").text = "74890957"
    004    MySession.findById("wnd[0]/usr/ctxtLIKP-VBELN").caretPosition = 8
    005    MySession.findById("wnd[0]").sendVKey 0
    006    MySession.findById("wnd[0]/mbar/menu[3]/menu[1]/menu[0]").select
    007    MySession.findById("wnd[0]/usr/tblSAPDV70ATC_NAST3/ctxtDNAST-KSCHL[1,3]").text = "zua4"
    008    MySession.findById("wnd[0]/usr/tblSAPDV70ATC_NAST3/ctxtDNAST-KSCHL[1,3]").setFocus
    009    MySession.findById("wnd[0]/usr/tblSAPDV70ATC_NAST3/ctxtDNAST-KSCHL[1,3]").caretPosition = 4
    010    MySession.findById("wnd[0]").sendVKey 0
    011    MySession.findById("wnd[0]/tbar[0]/btn[11]").press
    012    MySession.findById("wnd[0]/usr/chkNAST-DIMME").selected = true
    013    MySession.findById("wnd[0]/usr/ctxtNAST-LDEST").text = "locl"
    014    MySession.findById("wnd[0]/usr/txtNAST-ANZAL").text = "1"
    015    MySession.findById("wnd[0]/usr/txtNAST-ANZAL").setFocus
    016    MySession.findById("wnd[0]/usr/txtNAST-ANZAL").caretPosition = 1
    017    MySession.findById("wnd[0]/tbar[0]/btn[3]").press
    018    MySession.findById("wnd[0]/tbar[0]/btn[11]").press
    019    MySession.findById("wnd[0]/mbar/menu[0]/menu[6]").select
    020    MySession.findById("wnd[1]/usr/tblSAPLVMSGTABCONTROL").getAbsoluteRow(1).selected = true
    021    MySession.findById("wnd[1]/usr/tblSAPLVMSGTABCONTROL/txtNAST-KSCHL[0,1]").setFocus
    022    MySession.findById("wnd[1]/usr/tblSAPLVMSGTABCONTROL/txtNAST-KSCHL[0,1]").caretPosition = 0
    023    MySession.findById("wnd[1]/tbar[0]/btn[6]").press
    024    MySession.findById("wnd[2]/tbar[0]/btn[0]").press
    025    MySession.findById("wnd[1]/tbar[0]/btn[86]").press
STOP    026    

Sale525
tempName = ActiveWorkbook.Path & "\" & iBaseName & ".dbf"
ActiveWorkbook.SaveAs FileName:=tempName, FileFormat:=xlDBF4, CreateBackup:=False

Sale525, DmitryPrint
У меня работал и тот вариант без сохранения имени файла в отдельную переменную
Возможно формат XLS файла какойто не тот. Попробуй запустить эксель и сохранить файл в виде DBase IV. Я так понимаю в первой строке листа должны быть названия колонок, а во второй и далее данные. Может у тебя файлик не по стандарту.

chel78, Application.Wait Now() + TimeValue("00:00:03") - включит ту самую паузу на три секунды. Но утилизация процессора при этом будет под топ, к сожалению - "особенности национальной реализации" VBA

Я предпочитаю использовать объявление в начале модуля строки

Код: Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Цитата:

    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модераторуchel78, Application.Wait Now() + TimeValue("00:00:03") - включит ту самую паузу на три секунды. Но утилизация процессора при этом будет под топ, к сожалению - "особенности национальной реализации" VBA

Я предпочитаю использовать объявление в начале модуля строки

Код:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

А затем, в коде процедур, просто объявлять

Код:
Sleep 3000 ' Подождать 3 секунды

Но данная конструкция не прокатывает, если код расположен на объекте "Лист" или "Книга" - в этом случае приходится использовать старый добрый .Wait

Мм.. а как все это можно вписать в код ?

chel78, давай сначала. У тебя код в каком объекте находится? Лист? ЭтаКнига? Модуль? ЮзерФорма?

Вот сам файл
http://webfile.ru/4984681

работает в паре с SAP Gui (дополнение к Excel)

chel78, хорошо, тогда так: куда ты планируешь вставить сам скрипт, который приводился выше?

Добавлено:
Так, торможу, сек

Са м скрип записывается автоматом, я просто проделываю одно действие в SAP. и он готов, потом просто подставляю данные, на вкладку инпут шит, и запускаю его..

Походу тут только Application.Wait юзать придется Попробуй:

1. Перед имеющейся 13й строкой (ну и номер ) вставь пустую строку, соответственно поправив колонку ID
2. В ячейке С13 (которая у тебя должна получиться пустой!) вставь код Application.Wait Now() + TimeValue("00:00:03")
3. Сохрани книгу и оцени результат

Не получается ..
ошибку кажет

Цитата:

VBError --> Number: 424    Source: Microsoft VBScript runtime error    Description: Object required: 'Application'    Line: 9    Column: 0

В 9й строке как раз паузу прописал

А, там VBScript подключается... Тогда вместо

Код: Application.Wait ...

"VBError --> Number: 424    Source: Microsoft VBScript runtime error    Description: Object required: 'WScript'    Line: 5    Column: 0"


не идет

chel78, а если просто

Код: Sleep 1000 * 60 * 3

"VBError --> Number: 13    Source: Microsoft VBScript runtime error    Description: Type mismatch: 'Sleep'    Line: 5    Column: 0"

У меня варианты кончились Дока по надстройке есть?

Цитата:

Код:
Sleep 3000 ' Подождать 3 секунды

Но данная конструкция не прокатывает, если код расположен на объекте "Лист" или "Книга" - в этом случае приходится использовать старый добрый .Wait

Так надо сделать Sleep не приватной и тогда все бедет работать хоть откуда.

Добавлено:
Вообще-то 1000 * 60 * 3 слишеком много, несмотря на то что параметр она прринамает как Long, VBA выдает overflow. следай функцию которая будет вызывать sleep в цикле сколько надо раз

Цитата:

[Так надо сделать Sleep не приватной и тогда все бедет работать хоть откуда.

э того места поподробнее, пожалуйста...

при декларации функции Sleep, Вы используете слово Private, соответственно использование функции вне модуля будет невозможным, сами понимаете почему. Замените на Public

Возможно ли развернуть определенную группу (создана так: Rows(...).Group) средствами VBA?

развернуть опреденный левел
ActiveSheet.Outline.ShowLevels RowLevels:=2

свернуть все
ActiveSheet.Outline.ShowLevels RowLevels:=1

KF121

Цитата:

ActiveSheet.Outline.ShowLevels RowLevels:=2

Это действие разворачивает определенный левел во всех группах, а мне необходимо развернуть определенный левел в определенной группе. Как бы такое сделать..

Есть книга Excel 2007 в которую загружаются методом Copy/Paste данные. В данных есть лишние строки, которые нужно удалять. Сейчас я сейчас делаю это вручную.
Ищу все вхождения слова "Desc" в книге. От строки, включая, содержащую это слово выделяю 6 строк вверх и на панели нажимаю кнопку Удалить строки. Далее также удаляется следующее вхождение. Подскажите, как эту задачу автоматизировать макросом?
Данные меняются и привязываться к конкретным ячейкам невозможно.