[@Tromal5]

Добрый день. Помогите написать скрипт который будет:

У меня есть много файлов в папке С:\1\ имя1.csv имя2.csv .... имя99.csv
Нужно чтобы скрипт открывал файлы по очереди и запускал макрос, после выполнения макроса сохранял файл в С:\2\ как имя1.xlsx имя2.xlsx .... имя99.xlsx


Добавлено через 1 час 25 минут
Нашел на сайте вот этот скрипт:

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 strTempPath = "D:\PRIBOR" Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFolder=objFSO.GetFolder(strTempPath)     For Each objFile In objFolder.Files Ext = Mid(objFile, InstrRev(objFile, ".") + 1)   If Ext = "xls" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1) Set XL = CreateObject("Excel.Application") XL.Visible = False XL.Workbooks.Open objFile XL.ActiveWorkbook.SaveAs OutFile & ".csv",6 XL.ActiveWorkbook.Saved = True XL.ActiveWindow.Close XL.Quit End If Next

Он открывает файл и сохраняет с другим расширением. Помогите дописать его, чтобы перед закрытием он сначала выполнял макрос

Добавлено через 1 час 10 минут
Заметил такую проблему, если запустить первую часть скрипта:

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14  strTempPath = "D:\PRIBOR" Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFolder=objFSO.GetFolder(strTempPath)     For Each objFile In objFolder.Files Ext = Mid(objFile, InstrRev(objFile, ".") + 1)   If Ext = "csv" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1) Set XL = CreateObject("Excel.Application") XL.Visible = True XL.Workbooks.Open objFile End

То имя.csv открывается и значения всех ячеек переносятся в столбец А и разделяются между собой знаком ; (2;5;65;56;34;76).
А если открыть файл имя.csv вручную, то все нормально, каждое значение в своей ячейки. Подскажите как открыть скриптом этот долбанный.csv чтобы значения оставались в своих ячейках?

[@Dmitrii]

... перед закрытием он сначала выполнял макрос...

используйте метод Run объекта Application:

Visual Basic
1 XL.Run "module1.test1"

Здесь test1 - имя запускаемого макроса, module1 - имя модуля, в котором описан макрос.

... как открыть скриптом этот долбанный.csv чтобы значения оставались в своих ячейках?

Попробуйте использовать вместо метода Open объекта Workbooks метод OpenText того же объекта, указав True в качестве значения параметра Local (он последний, 18-й по счёту):

Visual Basic
1 XL.Workbooks.OpenText objFile, , , , , , , , , , , , , , , , , True

[@Tromal5]

Попробовал запустить на рабочем компе, получается совсем странно:
Исходный csv:

Код

       А      В      С      D
1:  Пусто | 3,15 | 5,67 | 4,85 |
2:  Пусто | 5,66 | 9,99 | 2,25 |
3:  Пусто | 1,45 | 5,08 | 6;53 |

Открывается методом Open:

Код

        А          В      С      D
1:      3;     | 15;5 | 67;4 |  85  |
2:      5;     | 66;9 | 99;2 |  25  |
3:      1;     | 45;5 | 08;6 |  53  |

Открывается методом OpenText:

Код

               А            В       С       D
1:      3;15;5;67;4;85  | Пусто | Пусто | Пусто | 
2:      5;66;9;99;2;25  | Пусто | Пусто | Пусто | 
3:      1;45;5;08;6;53  | Пусто | Пусто | Пусто |

[@Dmitrii]

Tromal5, приложите, пожалуйста, исходный CSV-файл (если не секрет, конечно).

[@Tromal5]

В архиве исходный csv и конечный результат xlsx

[@Dmitrii]

В вашем случае открывать CSV-файл надо так:

Visual Basic
1 XL.Workbooks.OpenText objFile, , , , , , , True

Однако, вероятно, будет проблема с кириллицей, т.к. исходный файл имеет кодировку UTF-8.
В этом случае перевести заголовочную часть на рабочем листе в нормальный вид можно, например, так:

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Set objFS = CreateObject("Scripting.FilesystemObject") arrTemp = Split(objFS.OpenTextFile(objFile, 1).ReadAll, ";") strTemp = StrConv(arrTemp(1), "utf-8", "windows-1251") Set XL = CreateObject("Excel.Application") XL.Visible = True XL.Workbooks.OpenText objFile, , , , , , , True XL.ActiveWorkbook.Worksheets(1).Range("a1").Value = StrConv(arrTemp(0), "utf-8", "windows-1251") XL.ActiveWorkbook.Worksheets(1).Range("b1").Value = Mid(strTemp, 1, InStr(strTemp, vbLf) - 1) XL.ActiveWorkbook.Worksheets(1).Range("a3").Value = Mid(strTemp, InStrRev(strTemp, vbLf) + 1)   '======   Function StrConv(strTxt, strSrcCharset, strDstCharset) Dim objStream   Set objStream = CreateObject("ADODB.Stream") objStream.Type = 2 objStream.Mode = 3 objStream.Open objStream.Charset = strDstCharset objStream.WriteText strTxt objStream.Position = 0 objStream.Charset = strSrcCharset StrConv = objStream.ReadText End Function

[@Tromal5]

Спасибо за помощь, сейчас файл открывается и сохраняется как нужно. Но так как этот файл будет использоваться на разных компьютерах, то макрос нужно вписать​ внутри кода.С этим у меня небольшая проблема.

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 strTempPath = "C:\Do*cuments and Settings*\757-Shishov\Рабочий стол\груздов" Set objFSO=CreateObj*ect("Scripting.FileS*ystemObject") Set objFolder=objFSO*.GetFolder(strTempPa*th)     For Each objFile In objFolder.Files Ext = Mid(objFile, InstrRev(objFile, ".") + 1)   If Ext = "csv" Then OutFile = Left(objFi*le.Path, Len(objFile*.Path) - Len(Ext) - 1)   Set XL = CreateObjec*t("Excel.Application*") XL.Visible = True 'XL.Workbooks.Open objFile,,,,,,,,,,,,,T*rue   XL.Workbooks.OpenText objFile, , , , , , , True     XL.Columns("A:A").Se*lect     XL.Selection.Del*ete Shift = xlToLeft     XL.Rows("1:1").S*elect     XL.Selection.Del*ete Shift = xlUp     XL.Selection.Del*ete Shift = xlUp     XL.Cells.Select     XL.Range("HO208"*).Activate     XL.Selection.Col*umnWidth = 0.25     XL.Cells.EntireR*ow.AutoFit                   XL.Selection.Row*Height = 2.25     XL.ActiveWindow.*ScrollRow = 1     XL.ActiveWindow.*ScrollColumn = 1       XL.Selection.For*matConditions.AddCol*orScale ColorScaleTy*pe = 3 XL.Selection.For*matConditions(Select*ion.FormatConditions*.Count).SetFirstPrio*rity XL.Selection.For*matConditions(1).Col*orScaleCriteria(1).T*ype = _         xlConditionV*alueLowestValue     With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(1).FormatColor         .Color = 7039480         .TintAndShade = 0     End With XL.Selection.For*matConditions(1).Col*orScaleCriteria(2).T*ype = _         xlConditionV*aluePercentile XL.Selection.For*matConditions(1).Col*orScaleCriteria(2).V*alue = 50     With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(2).FormatColor         .Color = 8711167         .TintAndShade = 0     End With XL.Selection.For*matConditions(1).Col*orScaleCriteria(3).T*ype = _         xlConditionV*alueHighestValue     With XL.Selectio*n.FormatConditions(1*).ColorScaleCriteria*(3).FormatColor         .Color = 8109667         .TintAndShade = 0     End With     'XL.ActiveWorkbook.S*aveAs OutFile & ".xl*sx" , 51 'XL.ActiveWorkbook.S*aved = True 'XL.ActiveWindow.Clo*se 'XL.Quit   Next

Строка: 28
Символ: 5
Ошибка: Индекс выходит за пределы допустимого диапазона.
До этой строки все работает как нужно.

Добавлено через 14 минут
Сори, В коде появились звездочки почему-то, не могу убрать их. Вот еще раз код без звездочек.

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 strTempPath = "C:\Documents and Settings\757-Shishov\Рабочий стол\груздов" Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFolder=objFSO.GetFolder(strTempPath)     For Each objFile In objFolder.Files Ext = Mid(objFile, InstrRev(objFile, ".") + 1)   If Ext = "csv" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)   Set XL = CreateObject("Excel.Application") XL.Visible = True 'XL.Workbooks.Open objFile,,,,,,,,,,,,,True   XL.Workbooks.OpenText objFile, , , , , , , True     XL.Columns("A:A").Select     XL.Selection.Delete Shift = xlToLeft     XL.Rows("1:1").Select     XL.Selection.Delete Shift = xlUp     XL.Selection.Delete Shift = xlUp     XL.Cells.Select     XL.Range("HO208").Activate     XL.Selection.ColumnWidth = 0.25     XL.Cells.EntireRow.AutoFit                   XL.Selection.RowHeight = 2.25     XL.ActiveWindow.ScrollRow = 1     XL.ActiveWindow.ScrollColumn = 1       XL.Selection.FormatConditions.AddColorScale ColorScaleType = 3 XL.Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority XL.Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _         xlConditionValueLowestValue     With XL.Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor         .Color = 7039480         .TintAndShade = 0     End With XL.Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _         xlConditionValuePercentile XL.Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50     With XL.Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor         .Color = 8711167         .TintAndShade = 0     End With XL.Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _         xlConditionValueHighestValue     With XL.Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor         .Color = 8109667         .TintAndShade = 0     End With     'XL.ActiveWorkbook.SaveAs OutFile & ".xlsx" , 51 'XL.ActiveWorkbook.Saved = True 'XL.ActiveWindow.Close 'XL.Quit   Next

[@Dmitrii]

Оператор в строке 28 должен выглядеть так:

Visual Basic
1 XL.Selection.FormatConditions.AddColorScale 3

[@Tromal5]

Спасибо, помогло. Оставил только эту строчку, остальные убрал, так как они все равно не дают нужный мне результат.
Сейчас код работает, но есть один недостаток.
Когда он раскрашивает ячейки, то он меньшие значения красит в красный, а большие в зеленый. Впринципе можно оставить и так, но так как это тепловизионный снимок, то гарячие места хотелось бы видеть красным, а не зеленым.

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 strTempPath = "C:\Documents and Settings\757-Shishov\Рабочий стол\груздов" Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFolder=objFSO.GetFolder(strTempPath)     For Each objFile In objFolder.Files Ext = Mid(objFile, InstrRev(objFile, ".") + 1)   If Ext = "csv" Then OutFile = Left(objFile.Path, Len(objFile.Path) - Len(Ext) - 1)   Set XL = CreateObject("Excel.Application") XL.Visible = True 'XL.Workbooks.Open objFile,,,,,,,,,,,,,True   XL.Workbooks.OpenText objFile, , , , , , , True     XL.Columns("A:A").Select     XL.Selection.Delete Shift = xlToLeft     XL.Rows("1:1").Select     XL.Selection.Delete Shift = xlUp     XL.Selection.Delete Shift = xlUp     XL.Cells.Select     XL.Range("HO208").Activate     XL.Selection.ColumnWidth = 0.25     XL.Cells.EntireRow.AutoFit                   XL.Selection.RowHeight = 2.25     XL.ActiveWindow.ScrollRow = 1     XL.ActiveWindow.ScrollColumn = 1       XL.Selection.FormatConditions.AddColorScale 3   'XL.ActiveWorkbook.SaveAs OutFile & ".xlsx" , 51 'XL.ActiveWorkbook.Saved = True 'XL.ActiveWindow.Close 'XL.Quit   Next

[@Dmitrii]

Ну, используйте что-нибудь такое:

Visual Basic

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 XL.Columns("A:A").Select     XL.Selection.Delete Shift = xlToLeft     XL.Rows("1:1").Select     XL.Selection.Delete Shift = xlUp     XL.Selection.Delete Shift = xlUp     XL.Cells.Select     XL.Range("HO208").Activate     XL.Selection.ColumnWidth = 0.25     XL.Cells.EntireRow.AutoFit                   XL.Selection.RowHeight = 2.25     XL.ActiveWindow.ScrollRow = 1     XL.ActiveWindow.ScrollColumn = 1       XL.Selection.FormatConditions.AddColorScale 3     XL.Selection.FormatConditions(XL.Selection.FormatConditions.Count).SetFirstPriority     XL.Selection.FormatConditions(1).ColorScaleCriteria(1).Type = 1     With XL.Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor         .ThemeColor = 7         .TintAndShade = 0.5     End With     XL.Selection.FormatConditions(1).ColorScaleCriteria(3).Type = 2     With XL.Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor         .Color = 255         .TintAndShade = 0     End With

Вы всегда можете подобрать приемлемый вариант, поэкспериментировав с настройками условного форматирования при включенном режиме записи макроса.
После завершения оформления остановите запись и посмотрите получившийся код.
Учтите, что все именованные константы объектной модели Excel надо заменить на их числовые значения. Например, константу xlConditionValueLowestValue надо заменить на значение 1.

[@Tromal5]

А чем заменить xlConditionValuePercentile и xlConditionValueHighestValue ?

[@Dmitrii]

Tromal5, всё необходимое можно легко найти с помощью инструмента Object Browser.