Помогите с ошибкой - VB

Узнай цену своей работы

Формулировка задачи:

здравствуйте! вообщем такое дело: сегодня у друга на компьютере сделал вещь на VBA которая перекидывает из текстовика в excel и распредиляет там по листам. сделал таким образом: из access запускаю excel с макросом. макрос в свою очередь уже и занимается вышеописынами вещами. вроде бы все сделал и все работало. но когда пришел домой и попробывал протестировать на своем ПК, стал выдавать ошибку "syntax error" и выделять первую строку данного куска кода

Решение задачи: «Помогите с ошибкой»

textual
Листинг программы 
<font color="blue">Option</font> <font color="blue">Explicit</font>

<font color="#00AA00">' *************************************</font>
<font color="#00AA00">' есть ли данный лист в данной книге</font>
<font color="blue">Private</font> <font color="blue">Function</font> IsWorkSheetExist(w <font color="blue">As</font> Workbook, sSName$) <font color="blue">As</font> <font color="blue">Boolean</font>
<font color="blue">Dim</font> c <font color="blue">As</font> <font color="blue">Object</font>
<font color="blue">On</font> <font color="blue">Error</font> <font color="blue">GoTo</font> errНandle:
<font color="blue">Set</font> c = w.Sheets(sSName)
<font color="#00AA00">' Альтернативный вариант :</font>
w.Worksheets(sSName).Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>) = w.Worksheets(sSName).Cells(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>)
IsWorkSheetExist = True
<font color="blue">Exit</font> <font color="blue">Function</font>
errНandle:
IsWorkSheetExist = False
<font color="blue">End</font> <font color="blue">Function</font>

<font color="#00AA00">' *************************************</font>
<font color="blue">Private</font> <font color="blue">Sub</font> Workbook_Open()
<font color="blue">Dim</font> wb <font color="blue">As</font> Workbook, sh <font color="blue">As</font> Worksheet
<font color="blue">Dim</font> a&, lLastRow&, k&
<font color="blue">Dim</font> tmp$, sSheetName$

Application.ScreenUpdating = False

Workbooks.OpenText Filename:=<font color="teal">"H:\on123.txt"</font>, Origin:=<font color="darkblue"><b>866</b></font>, StartRow:=<font color="darkblue"><b>1</b></font>, _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=True, Tab:=True, Semicolon:=False, Comma:=False, Space:=True, Other _
        :=False, FieldInfo:=Array(Array(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>1</b></font>), Array(<font color="darkblue"><b>2</b></font>, <font color="darkblue"><b>1</b></font>), Array(<font color="darkblue"><b>3</b></font>, <font color="darkblue"><b>1</b></font>)), _
        TrailingMinusNumbers:=True

<font color="blue">Set</font> wb = Workbooks(Workbooks.Count)
wb.SaveAs Filename:=<font color="teal">"H:\on123123"</font>, FileFormat:=xlExcel5

        <font color="#00AA00">'==bla bla bla )====</font>

<font color="blue">With</font> wb.Worksheets(<font color="darkblue"><b>1</b></font>)
    lLastRow = .Cells.SpecialCells(xlLastCell).Row
    
    <font color="blue">For</font> a = <font color="darkblue"><b>1</b></font> <font color="blue">To</font> lLastRow
        tmp = <font color="blue">Mid</font>(.Cells(a, <font color="darkblue"><b>1</b></font>), <font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>6</b></font>)
        
        <font color="blue">Select</font> <font color="blue">Case</font> tmp
            <font color="blue">Case</font> <font color="teal">"351352"</font>:  sSheetName = <font color="teal">"оптс"</font>
            <font color="blue">Case</font> <font color="teal">"351356"</font>:  sSheetName = <font color="teal">"56"</font>
            <font color="blue">Case</font> <font color="blue">Else</font>:      sSheetName = <font color="teal">""</font>
        <font color="blue">End</font> <font color="blue">Select</font>
        
        <font color="blue">If</font> sSheetName = <font color="teal">""</font> <font color="blue">Then</font>
             <font color="#00AA00">' обработка непредвиденных случаев</font>

        <font color="blue">Else</font>
            <font color="blue">If</font> IsWorkSheetExist(wb, sSheetName) <font color="blue">Then</font>
                <font color="blue">Set</font> sh = .Parent.Worksheets(sSheetName)
                k = sh.Cells.SpecialCells(xlLastCell).Row + <font color="darkblue"><b>1</b></font>
            <font color="blue">Else</font>
                <font color="blue">Set</font> sh = .Parent.Worksheets.Add
                sh.<font color="blue">Name</font> = sSheetName
                k = <font color="darkblue"><b>1</b></font>
            <font color="blue">End</font> <font color="blue">If</font>
<font color="#00AA00">'' rem можно и без функции IsWorkSheetExist</font>
<font color="#00AA00">''            On Error Resume Next</font>
<font color="#00AA00">''            Set sh = .Parent.Worksheets(sSheetName)</font>
<font color="#00AA00">''            If Err.Number <> 0 Then</font>
<font color="#00AA00">''                Err.Clear</font>
<font color="#00AA00">''                Set sh = .Parent.Worksheets.Add</font>
<font color="#00AA00">''                sh.Name = sSheetName</font>
<font color="#00AA00">''                k = 1</font>
<font color="#00AA00">''            Else</font>
<font color="#00AA00">''                k = sh.Cells.SpecialCells(xlLastCell).Row + 1</font>
<font color="#00AA00">''            End If</font>
<font color="#00AA00">''            On Error GoTo 0</font>
<font color="#00AA00">'' rem</font>
            
            .Rows(a).Copy sh.Cells(k, <font color="darkblue"><b>1</b></font>)
        <font color="blue">End</font> <font color="blue">If</font>
    <font color="blue">Next</font> a
<font color="blue">End</font> <font color="blue">With</font> <font color="#00AA00">' wb.Worksheets(1)</font>

Application.CutCopyMode = False
Application.ScreenUpdating = True

<font color="#00AA00">'=====bla bla ( =====</font>
       <font color="#00AA00">'Workbooks(<font color="teal">"start.xlsm"</font>).Close</font>
<font color="blue">End</font> <font color="blue">Sub</font>

ИИ для рефератов и докладов

  • Экспорт Word по ГОСТу
  • Минимум 80% уникальности текста
  • Поиск релевантных источников в интернете
  • Готовый документ за 2 минуты

Оцени полезность:

12   голосов , оценка 4.25 из 5