Поставил более новую версию эксель и макрос перестал выполняться. Сразу вылетает ошибка и эксель закрывается.
Макрос внизу.
В чем проблема?
Макрос внизу.
В чем проблема?
Код |
---|
Option Explicit Const strDelimiter = """" Const strDelimiterEscaped = strDelimiter & strDelimiter Const strSeparator = ";" Const strRowEnd = vbCrLf Const strCharset = "utf-8" Function CsvFormatString(strRaw As String) As String Dim boolNeedsDelimiting As Boolean boolNeedsDelimiting = InStr(1, strRaw, strDelimiter) > 0 _ Or InStr(1, strRaw, Chr(10)) > 0 _ Or InStr(1, strRaw, strSeparator) > 0 CsvFormatString = strRaw If boolNeedsDelimiting Then CsvFormatString = strDelimiter & _ Replace(strRaw, strDelimiter, strDelimiterEscaped) & _ strDelimiter End If End Function Function CsvFormatRow(rngRow As Range) As String Dim arrCsvRow() As String ReDim arrCsvRow(rngRow.Cells.Count - 1) Dim rngCell As Range Dim lngIndex As Long lngIndex = 0 For Each rngCell In rngRow.Cells arrCsvRow(lngIndex) = CsvFormatString(rngCell.Text) lngIndex = lngIndex + 1 Next rngCell CsvFormatRow = Join(arrCsvRow, ";") & strRowEnd End Function Sub CsvExportRange( _ rngRange As Range, _ Optional strFileName As Variant _ ) Dim rngRow As Range Dim objStream As Object If IsMissing(strFileName) Or IsEmpty(strFileName) Then strFileName = Application.GetSaveAsFilename( _ InitialFileName:=ActiveWorkbook.Path & "\" & rngRange.Worksheet.Name & ".csv", _ FileFilter:="CSV (*.csv), *.csv", _ Title:="Export CSV") End If Set objStream = CreateObject("ADODB.Stream") objStream.Type = 2 objStream.Charset = strCharset objStream.Open For Each rngRow In rngRange.Rows objStream.WriteText CsvFormatRow(rngRow) Next rngRow objStream.SaveToFile strFileName, 2 objStream.Close End Sub Sub CsvExportSelection() CsvExportRange ActiveWindow.Selection MsgBox "CSV file, with selected range is ready." End Sub Sub CsvExportSheet() Dim wksSheet As Worksheet Set wksSheet = ActiveSheet CsvExportRange wksSheet.UsedRange MsgBox "CSV file, with active sheet is ready." End Sub |