Hola Jonay,
Yo uso una plantilla definida y inserto varias tablas en la casilla que le digo y hoja que le digo:
Depurala un poco
Un pequeño ejemplo:
Sub Inicio_Proceso
'this displays a Yes / No message box
Answer = MsgBox("Deseas actualizar el listado?",4,"Actualización Listado")
If (Answer=6) Then
call exportToExcel
'MyApp.Quit
Else
End If
End Sub
sub exportToExcel
Dim aryExport(2,3)
aryExport(0,0) = "OB_Vintage" 'Nombre del objeto
aryExport(0,1) = "1-Summary" 'Pestaña del excel
aryExport(0,2) = "B4" 'Celda
aryExport(0,3) = "data" 'Tipo de dato a pegar.
aryExport(1,0) = "OB_Vintage"
aryExport(1,1) = "3-Total Strats"
aryExport(1,2) = "B6"
aryExport(1,3) = "data"
aryExport(2,0) = "OB_Range"
aryExport(2,1) = "3-Total Strats"
aryExport(2,2) = "B18"
aryExport(2,3) = "data"
Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)
end sub
Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook
Dim i 'as Integer
Dim objExcelApp 'as Excel.Application
Dim objExcelDoc 'as Excel.Workbook
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = true 'false if you want to hide Excel
objExcelApp.DisplayAlerts = false
'Set objExcelDoc = objExcelApp.Workbooks.Add
Set objExcelDoc = objExcelApp.Workbooks.Open("C:\jarenas\Plantilla " & getVariable("vSheetName") & ".xlsm") 'Aquí es donde tienes que poner la ruta de tu plantilla. Si lo deseas tambien puedes crear un nuevo documento y en la array recuerda poner la Hoja como Hoja1. Yo lo tengo así porque tengo varias Sheets en el qlikview y me van rellenando varias plantillas segun el nombre de la sheet de ahí la getVariable("vSheetName")
Set MyApp = CreateObject("QlikTech.QlikView")
Dim strSourceObject
Dim qvObjectId 'as String
Dim sheetName
Dim sheetRange
Dim pasteMode
Dim objSource
Dim objCurrentSheet
Dim objExcelSheet
for i = 0 to UBOUND(aryExportDefinition)
'// Get the properties of the exportDefinition array
qvObjectId = aryExportDefinition(i,0)
sheetName = aryExportDefinition(i,1)
sheetRange = aryExportDefinition(i,2)
pasteMode = aryExportDefinition(i,3)
Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)
if (objExcelSheet is nothing) then
Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)
if (objExcelSheet is nothing) then
msgbox("No sheet could be created, this should not occur!!!")
end if
end if
objExcelSheet.Select
set objSource = qvDoc.GetSheetObject(qvObjectId)
Call objSource.GetSheet().Activate()
'objSource.Maximize
qvDoc.GetApplication.WaitForIdle
if (not objSource is nothing) then
if (pasteMode = "image") then
Call objSource.CopyBitmapToClipboard()
else
Call objSource.CopyTableToClipboard(true) '// default & fallback
end if
Set objCurrentSheet = objExcelDoc.Sheets(sheetName)
objExcelDoc.Sheets(sheetName).Range(sheetRange).Select
objExcelDoc.Sheets(sheetName).PasteSpecial Paste = xlPasteValues
if (pasteMode <> "image") then
With objExcelApp.Selection
.WrapText = True
.ShrinkToFit = False
End With
end if
objCurrentSheet.Range("A1").Select
end if
next
Call Excel_DeleteBlankSheets(objExcelDoc)
'// Finally select the first sheet
objExcelDoc.Sheets(1).Select
'// Return value
Set copyObjectsToExcelSheet = objExcelDoc
end function
'//*********************** MACRO EXCEL ***********************************
'// ****************************************************************
'// Valor de la variable
'// ****************************************************************
public function getVariable(varName)
set v = ActiveDocument.Variables(varName)
getVariable = v.GetContent.String
end function
'// ________________________________________________________________
'// ****************************************************************
'// Internal function for getting the Excel sheet by sheetName
'// ****************************************************************
Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet
For Each ws In objExcelDoc.Worksheets
If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then
Set Excel_GetSheetByName = ws
exit function
End If
Next
'// default return value
Set Excel_GetSheetByName = nothing
End Function
'// ________________________________________________________________
Private Function Excel_GetSafeSheetName(sheetName)
'// can be max 31 characters long
retVal = trim(left(sheetName, 31))
Excel_GetSafeSheetName = retVal
End Function
'// ****************************************************************
'// Internal function for adding a new sheet
'// ****************************************************************
Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet
'// add a sheet to the last position
objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
Dim objNewSheet
Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
objNewSheet.Name = left(sheetName,31)
'// return the newly created sheet
Set Excel_AddSheet = objNewSheet
End function
'// ________________________________________________________________
'// ****************************************************************
'// Delete all empty sheets
'// ****************************************************************
Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)
For Each ws In objExcelDoc.Worksheets
If (not HasOtherObjects(ws)) then
If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
On Error Resume Next
Call ws.Delete()
End If
End If
Next
End Sub
'// ________________________________________________________________
