合并单元格中的CopyFromRecordset

时间:2015-06-26 09:10:24

标签: excel vba excel-vba

我正在尝试将几个查询从Access数据库移动到Excel。 现在,其中一个查询必须在包含合并单元格的一张纸上,但这导致我输错了。

查询的代码是:

Public Sub CreateExcelInfo()
'Set reference to Microsoft Excel Object library
'Set reference to Microsoft ActiveX DataObject 2.x

Dim oExcel As New Excel.Application
Dim WB As New Excel.Workbook
Dim WS As Excel.Worksheet
Dim rng As Excel.Range
Dim objRs5 As New ADODB.Recordset
MsgBox ("Este proceso puede tardar unos minutos." & Chr(13) & Chr(13) & Chr(13) & "Por favor abstengase de realizar tareas en el equipo hasta ver el mensaje de finalizado."), vbOKOnly
sFileNameTemplate = Application.CurrentProject.Path & "\templates\Informes.xlsm"
sSQL5 = "SELECT [COMENTARIOS ÚLTIMO CIERRE].TipoComentarioInventario, [COMENTARIOS ÚLTIMO CIERRE].Comentario FROM [COMENTARIOS ÚLTIMO CIERRE] " 'Export comments last inventory

With oExcel
.Visible = True
        Set WB = .Workbooks.Add(sFileNameTemplate)
            With WB
                          objRs5.Open sSQL5, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
                          Set rng = .Range("B24")
                          rng.CopyFromRecordset objRs5
                          objRs5.Close
                 End With
            End With

Set objRs5 = Nothing
MsgBox ("!El informe se ha realizado correctamente!"), vbOKOnly

End Sub

这是包含查询和工作表的图像,现在代码正在运行:

http://oi62.tinypic.com/2nu0xur.jpg

1 个答案:

答案 0 :(得分:0)

一个简单的解决方法是先将数据导入excel,然后进行格式化(和计算)。

在.copyfromrecordset步骤之前取消合并单元格:

Rng.MergeCells = False

然后在

之后重新合并细胞
Rng.MergeCells = True

我也会关闭屏幕更新,因此用户看起来并不陌生。