Здравствуйте,
Моей задачей было создать макрос, чтобы при сохранении файла Excel, создавался также этот файл в формате .csv. Но у меня никак не получается сделать так, чтобы данные в csv были в UTF-8. (При открытии csv файла, на месте текстовых полей у меня отображаются знаки вопроса). Экслевский файл во вложении.
Моей задачей было создать макрос, чтобы при сохранении файла Excel, создавался также этот файл в формате .csv. Но у меня никак не получается сделать так, чтобы данные в csv были в UTF-8. (При открытии csv файла, на месте текстовых полей у меня отображаются знаки вопроса). Экслевский файл во вложении.
Код |
---|
Sub csvDelim() Dim i As Long, j As Long Dim PathForFile As String Dim NameForSave As String Dim tempstr As String Dim Rn As Range Dim Delim1 As String Dim Delim2 As String Dim Val On Error Resume Next PathForFile$ = ThisWorkbook.Path & "\csv файл\": MkDir PathForFile$ MsgBox "На вашем локальном диске будет создана папка ""csv файл""", vbOKOnly, "Создание папки" If Err.Number <> 75 And Err.Number <> 0 Then GoTo Ext Err.Clear On Error GoTo Ext NameForSave = InputBox("Введите маску имени файла", "Ввод", ActiveWorkbook.Name) Delim1 = CStr(";") Delim2 = CStr("") Randomize NameForSave = NameForSave & "_" & CStr(Date) Set Rn = Range("A1:Q1") i = 1 While Len(Rn.Cells(1).Offset(i).Value) > 0 i = i + 1 Wend If i = 1 Then Exit Sub Val = Rn.Offset(1).Resize(i).Value On Error Resume Next Kill PathForFile$ & "\" & NameForSave & ".csv" Err.Clear On Error GoTo Ext Open PathForFile$ & "\" & NameForSave & ".csv" For Output As #1 For i = 1 To UBound(Val, 1) - 1 tempstr = Delim2 & CStr(Val(i, 1)) & Delim2 For j = 2 To UBound(Val, 2) tempstr = tempstr & Delim1 & Delim2 & CStr(Val(i, j)) & Delim2 Next j Print #1, tempstr Next i Close #1 Exit Sub Ext: MsgBox "извините, ошибка!" & Err.Number & " " & Err.Description, vbOKOnly, "Отмена" End Sub |