Офис 2007

[NOLAN]

Помогите !!! Есть макрос написанный на VBA, работает на всех компах, кроме моего, на который я поставил позавчера название темы ... Секретность и все прочие я уже поотключал ... Но все одно выдает ошибку 445 "Object doesn't support this action" ... Спасите !!!!!!!!!!

[KAA]

А нефиг офиса недоделаные ставить...

[NOLAN]

А нефиг офиса недоделаные ставить...

Не зларадствуй, он у нас и так лицензионный )))

[Drozd]

гы... все одно что диагностировать рак по фото...

Alt-F11 - редактор VBA. Tools-References - убедись, что перечень ссылок на библиотеки у тебя и на других компах одинаков. Это как минимум. Там-же заодно можешь попытаться отследить инструкцию, на которой он спотыкается. Ну, тривиальными отладчиками тя учить пользоваться не буду. Успеха.

[NOLAN]

В том-то и дело, что я это уже пробовал и не только это - тут какая-то шнагя именно между версиями офиса ... ((((

[Drozd]

В том-то и дело, что я это уже пробовал и не только это - тут какая-то шнагя именно между версиями офиса ... ((((

Т.е. работает только на предыдущих, чтоль?

 

Текст можешь кинуть?

[NOLAN]

Текст можешь кинуть?

Sub csv_to_cdr()

'

' Ìàêðîñ1 Ìàêðîñ

' Ìàêðîñ çàïèñàí 24.10.2006 (Kraut)

'

'

With ActiveSheet

Dim in_file, out_file, v_startrow, v_sheetno, v_rows, v_cols, trunk_out, trunk_in, dat, dlit, flag, ved, wo_hour, tmp_i, z, nash_in, nash_out, x, fi, new_name, zu

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, ts, s, one, two, Atc

in_file = .Cells(2, 1)

out_file = .Cells(2, 2)

 

 

For j = 4 To 65000

If (.Cells(j, 2) <> "") Then

t_Atc(j - 3) = .Cells(j, 1)

t_out(j - 3) = .Cells(j, 2)

t_in(j - 3) = .Cells(j, 3)

t_nash(j - 3) = .Cells(j, 4)

t_zam(j - 3) = .Cells(j, 5)

End If

Next j

 

Dim filename, num_ch

Dim max_col

Set fs = CreateObject("Scripting.FileSystemObject")

Set fssearch = Application.FileSearch

With fssearch

.LookIn = in_file

.filename = "*.csv"

If .Execute > 0 Then

If (.FoundFiles.Count = 0) Then

MsgBox " ïàïî÷êå " & in_file & " ôàéëû csv íå íàéäåíû"

Exit Sub

End If

For i = 1 To .FoundFiles.Count

''Set fi = fs.GetFile(.FoundFiles(i))

new_name = Mid(.FoundFiles(i), 1, Len(.FoundFiles(i)) - 4)

fs.MoveFile .FoundFiles(i), new_name

v_csv = new_name

v_short_csv = v_csv

Position = InStr(1, v_short_csv, "\")

While (Position <> 0)

v_short_csv = Mid(v_short_csv, Position + 1)

Position = InStr(1, v_short_csv, "\")

Wend

v_short_csv = Trim(v_short_csv)

'wo_hour = Mid(v_short_csv, 1, Len(v_short_csv) - 5)

wo_hour = "384NVK-ATS71_" & _

Mid(v_short_csv, 8, 4) & _

Mid(v_short_csv, 13, 2) & _

Mid(v_short_csv, 16, 2) & _

"09_0002.CDR"

fs.CreateTextFile out_file & "\" & wo_hour 'Create a file

Set f = fs.GetFile(out_file & "\" & wo_hour)

Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

ts.Write ""

ts.Close

'fs = Nothing

Next i

End If

.filename = "*.*"

If .Execute > 0 Then

tmp_i = .FoundFiles.Count

For z = 1 To .FoundFiles.Count

i = tmp_i + 1 - z

v_csv = .FoundFiles(i)

v_short_csv = v_csv

Position = InStr(1, v_short_csv, "\")

While (Position <> 0)

v_short_csv = Mid(v_short_csv, Position + 1)

Position = InStr(1, v_short_csv, "\")

Wend

v_short_csv = Trim(v_short_csv)

 

' wo_hour = Mid(v_short_csv, 1, Len(v_short_csv) - 5)

wo_hour = "384NVK-ATS71_" & _

Mid(v_short_csv, 8, 4) & _

Mid(v_short_csv, 13, 2) & _

Mid(v_short_csv, 16, 2) & _

"09_0002.CDR"

 

' Open CSV

'----------------------------------

Workbooks.OpenText filename:=v_csv, Origin:=xlWindows, _

StartRow:=1, _

DataType:=xlDelimited, _

TextQualifier:=xlNone, _

ConsecutiveDelimiter:=False, _

Tab:=False, _

Semicolon:=True, _

Comma:=False, _

Space:=False, _

Other:=False

 

Windows(v_short_csv).Activate

' Windows(v_short_csv).Visible = False

With ActiveSheet

 

'fs.CreateTextFile out_file & "\" & wo_hour 'Create a file

Set f = fs.GetFile(out_file & "\" & wo_hour)

Set ts = f.OpenAsTextStream(ForAppending, TristateUseDefault)

For j = 3 To 65000

If .Cells(j, 1) = "" Then

col = j

Exit For

End If

Next j

For j = 3 To col

flag = False

one = ""

two = ""

For k = j + 1 To j + 50

If (.Cells(k, 1) = "4060") Then

zu = 1

End If

If ( _

(.Cells(j, 2) = .Cells(k, 2)) And _

(.Cells(j, 3) = .Cells(k, 3)) And _

(.Cells(j, 4) = .Cells(k, 4)) And _

(.Cells(j, 5) = .Cells(k, 5)) And _

(.Cells(j, 8) = .Cells(k, 8)) And _

(.Cells(j, 9) = .Cells(k, 9)) And _

(.Cells(j, 13) = .Cells(k, 13)) _

) Then

If (.Cells(k, 11) = "") Then

.Cells(k, 11) = .Cells(j, 11)

End If

If (.Cells(k, 12) = "") Then

.Cells(k, 12) = .Cells(j, 12)

End If

flag = True

Exit For

End If

Next k

If (flag = True) Then

flag = False

Else

If (.Cells(j, 1) <> "") And (.Cells(j, 6) = "") _

And (InStr(.Cells(j, 8), "*") = 0) And (InStr(.Cells(j, 9), "*") = 0) _

And (InStr(.Cells(j, 8), "#") = 0) And (InStr(.Cells(j, 9), "#") = 0) Then

' óñëîâèå íà òî ÷òî ýòî íàì íóæíî

one = .Cells(j, 8)

two = .Cells(j, 9)

trunk_out = .Cells(j, 11)

trunk_in = .Cells(j, 12)

dat = ""

dlit = ""

If (.Cells(j, 2) = "") Then

dat = dat & Format(.Cells(j, 4), "yyyyMMdd")

dat = dat & Format(.Cells(j, 5), "hhmmss")

Else

dat = dat & Format(.Cells(j, 2), "yyyyMMdd")

dat = dat & Format(.Cells(j, 3), "hhmmss")

End If

dlit = dlit & Second(.Cells(j, 13)) + Minute(.Cells(j, 13)) * 60 + Hour(.Cells(j, 13)) * 3600

nash_in = ""

nash_out = ""

If (trunk_in = "") Then

ved = in_ved(one)

If (ved <> 0) Then

trunk_in = t_in(ved)

nash_in = t_nash(ved)

End If

End If

If (trunk_out = "") And (Left(two, 1) <> "8") Then

ved = in_ved(two)

If (ved <> 0) Then

trunk_out = t_out(ved)

nash_out = t_nash(ved)

End If

End If

If ((trunk_in <> "") And ((nash_in = "N") Or (nash_in = ""))) Or ((trunk_out <> "") And ((nash_in = "N") Or (nash_in = ""))) Then

If Not ((Len(one) = 7) And (Mid(one, 1, 1) <> "3")) Then

ts.Write ",,,,,"

If (one <> "384") And (one <> "") Then ' åñëè '384' òî íè÷å íå ïèøåì

If (Len(one) = 7) And (Mid(one, 1, 1) = "3") Then

one = "73843" & Mid(one, 2)

Else

one = "7" + one ' ïðèïèñûâàåì ñåìåðêó

End If

Else

one = "" ' íè÷åãî

If (trunk_in <> "") Then

If (Left(trunk_in, 4) = "ATSE") Then

For x = 1 To col

If (Len(t_Atc(x)) = 2) Then

If (Mid(trunk_in, 5, 2) = t_Atc(x)) Then

one = t_zam(x)

Exit For

End If

End If

Next x

Else

For x = 1 To col

If (t_in(x) = trunk_in) Then

one = t_zam(x)

End If

Next x

End If

End If

End If

 

ts.Write one

ts.Write ","

 

If (Len(two) = 6) Then ' åñëè íîìåð 6 çíàêîâ òî ïðèïèñûâàåì '73843'

two = "73843" & two

Else

If (Len(two) = 10) Then ' åñëè íîìåð 10 çíàêîâ òî ïðèïèñûâàåì '7'

two = "7" & two

Else

If (Mid(two, 1, 5) = "82777") Then

two = "7384777"

Else

If (Mid(two, 1, 5) = "82779") Then

two = "7384779"

Else

If (Mid(two, 1, 2) = "82") Then

two = "7384" + Mid(two, 3)

Else

If (Len(two) >= 13) And (Mid(two, 1, 3) = "810") Then

two = Mid(two, 4)

Else

If (Len(two) >= 9) And (Mid(two, 1, 1) = "8") Then

two = "7" + Mid(two, 2)

End If

End If

End If

End If

End If

End If

End If

ts.Write two & ","

ts.Write dat & ","

ts.Write dlit & ","

ts.Write ",,,,,,,,,,,,,,,,,"

ts.Write "384"

ts.Write ",,,,"

ts.Write trunk_in

ts.Write ","

ts.Write trunk_out

ts.Write ",,,,,,"

ts.Write vbNewLine

End If

End If

End If

End If

Next j

 

ts.Close

End With

Windows(v_short_csv).Close False

'MsgBox .FoundFiles(i)

' new_name = Mid(.FoundFiles(i), 1, Len(.FoundFiles(i)) - 4)

fs.MoveFile .FoundFiles(i), .FoundFiles(i) & ".csv"

Next z

Else

MsgBox " ïàïî÷êå " & in_file & " ôàéëû csv íå íàéäåíû"

End If

End With

End With

MsgBox "Óñå!"

End Sub

Function in_ved(tel)

Dim i, j, co, tmp

If tel = "384" Then

in_ved = 0

Exit Function

End If

 

tmp = Right(tel, 6)

For i = 1 To 5

co = 7 - i

For j = 1 To col

If (Len(t_Atc(j)) = co) Then

If (Left(tmp, co) = t_Atc(j)) Then

in_ved = j

Exit Function

End If

End If

Next j

Next i

in_ved = 0

End Function

[Drozd]

Слухай, а в какой версии оффиса работает?

 

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

 

объект.Cells(x,y) = ...

 

с какого-то момента (толи патч, толи очередная версия оффиса) перестали работать. Т.е. читаться давались, а записываться только через .Range(..).

И помнится, проблема с локализацией ошибки была как раз в том, что толком на место ее возникновения отладчик указать не мог... Но могу ошибаться...

[Холодное Тело]

Я могу ошибаться но где-то читал что доки соzданные на более ранних версих офиса либо могут глючить либо вообще не открываться. Пиши в техподдержку рэдмонского гиганта

[NOLAN]

Там не док - там CSV-файл, текстовый файл со статистикой, поля разделены запятыми, формируемый прогой шедшей с АТС ...

 

Где-то, как я называю, "эффект галочки" - короче какая-то мелочь не отмечена ...

[Nickie]

Олег, а такой вариант что у всех тип адресации ячеек в стиле "R1C1", а у тебя "A1" - не возможен? В смысле не так ли?

[NOLAN]

Надо было тему назвать новые продукты Мicrosoft )))

 

Блин, поставил новый IE - сволочь, он ничего кроме как go.microsoft что-там дальше, как домашную страницку не воспринимает ...

Лицензионная XP2 напрочь не хочет работать с сайтами VS через MS-овскую же проксю - ей давай прямой выход в Инет ...

 

Тихо начинаю любить Unix ))))

[NOLAN]

По поводу скрипта:

вылетает на строчке - Set fssearch = Application.FileSearch

опять сцуки что-то поменяли (((((

[Tia_]

Все свои макросы для работы в Office 2007 пришлось редактировать, т.к. VBA спотыкался об FileSearch

БЫЛО:

 

With Application.FileSearch

.LookIn = MyFileway

.Filename = MyFilename

If .Execute > 0 Then ....

 

ПРИШЛОСЬ ИСПРАВИТЬ НА:

 

Dim s as string

...

s = Dir(MyFileway& MyFilename)

If s <> "" Then ....