Есть рабочий макрос для сохранения таблицы в CSV с кодировкой UTF8.
Хотелось бы из него сделать надстройку, вывести кнопку на панель и сохранять так в любой таблице.
Воспользовался этим советом:
| Цитата |
|---|
Надстройка - это обычная книга Excel (у надстройки свойство IsAddin=True) - создаешь книгу и сохраняешь как blabla.xla(m) и все.
Теперь ее нужно прикрепить:
2007. Кнопка "Office" - Параметры Excel - Надстройки (вкладка слева) -
Управление: [Надстройки Excel] Перейти... Появится окно "Надстройки", жми "Обзор..." и, собственно, ищи тот самый файл blabla.xla(m). Галочка стоит - надстройка "с нами", не стоит - "отдыхает". |
Но при попытке выполнения, получают вот такое сообщение: object variable or with block variable not set
Как я понял надо особым образом подправить макрос, чтоб он мог работать в качестве надстройки, но не пойму что именно править.
Делается для office 2010.
Макрос во вложении, ну и сюда добавлю:
Скрытый текст |
|---|
| Код |
|---|
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 |
|
