Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hi All
Is it possible to export the entire Dashboard to a MS Office Document... as we have tried and got the some solution to export certain objects from dashboard to a word document but not complete dashboard.
Someone please guide us to find the better solution for the same.
Thanks in advance!
Rajesh
You can try with NPrinting ..it will help you to export all the objects easily to the word document ...
check this
' Exportar a Power Point ...
Sub Export_QVDoc_2_PPT
' Recuperar el nombre del documento para el nombre del archivo .PPT
QVDocName = ActiveDocument.GetPathName ' con el path completo
QVDocName = Mid(QVDocName, InStrRev(QVDocName, "\") + 1) ' eliminamos la parte del path
QVDocName = Left(QVDocName, InStrRev(QVDocName, ".qvw") - 1) ' eliminamos la extensión
' Editar la fecha y la hora para construir el nombre del archivo .PPT
Ahora = Year(Date)
if Month(Date) < 10 then
Ahora = Ahora & "0" & Month(Date)
else
Ahora = Ahora & Month(Date)
end if
if Day(Date) < 10 then
Ahora = Ahora & "0" & Day(Date)
else
Ahora = Ahora & Day(Date)
end if
Ahora = Ahora & " "
if Hour(Time) < 10 then
Ahora = Ahora & "0" & Hour(Time)
else
Ahora = Ahora & Hour(Time)
end if
if Minute(Time) < 10 then
Ahora = Ahora & "0" & Minute(Time)
else
Ahora = Ahora & Minute(Time)
end if
if Second(Time) < 10 then
Ahora = Ahora & "0" & Second(Time)
else
Ahora = Ahora & Second(Time)
end if
' Construir el nombre .PPT con el nombre del documento QV + fecha + hora
PPTDocName = "C:\TEMP\" & QVDocName & " " & Ahora & ".ppt"
' Comprobar si no existe la carpeta para crearla
dim fsoObj
set fsoObj = CreateObject("Scripting.FileSystemObject")
if fsoObj.FolderExists("C:\TEMP")=false then
fsoObj.CreateFolder("C:\TEMP")
end if
Set fsoObj = Nothing
' Guardamos la hoja activa
HojaActivaID = ActiveDocument.ActiveSheet.GetProperties.SheetID
' Exportar las pestañas del .qvw como diapositivas ppt
Set PPT_App = CreateObject("PowerPoint.Application")
PPT_App.Visible = True
Set PPT_Pres = PPT_App.Presentations.Add(True)
for i = 0 to ActiveDocument.NoOfSheets - 1
set ss= ActiveDocument.GetSheet(i)
SheetId = ss.GetProperties.SheetId
SheetId = Mid(SheetId, InStrRev(SheetId, "\") + 1)
If SheetId <> "SH00" and SheetId <> "SH01" then
Set PPT_Slide = PPT_Pres.Slides.Add(PPT_Pres.Slides.Count + 1, 12)
ActiveDocument.ActivateSheetByID ss.GetProperties.SheetId
ActiveDocument.GetApplication.WaitForIdle
ActiveDocument.GetApplication.Sleep 2000 '2000 milisegundos
ActiveDocument.ActiveSheet.CopyBitmapToClipboard
with PPT_Slide.Shapes.Paste
.LockAspectRatio = False
.Left = 0
.Top = 0
.Width=720
.Height=550
end with
end if
next
' Guardar el documento y cerrar el PowerPoint
PPT_Pres.SaveAs PPTDocName
PPT_Pres.Close
PPT_App.Quit
Set PPT_Slide = Nothing
Set PPT_Pres = Nothing
Set PPT_App = Nothing
' Activamos la hoja que hemos guardado antes del export
ActiveDocument.ActivateSheetByID HojaActivaID
' Mensaje de finalización
Texto = "Documento " & chr(39) & PPTDOcName & chr(39) & " creado correctamente."
Retorno = MsgBox (Texto, vbInformation)
End Sub
Hi Avinash
Thank u for u r advice,but i am trying to achieve in QV as i don't have Nprinting Licence
This macro export a complete qvw to ppt and you don't need to buy NPrinting license
The code and the variables are written in spanish, if you have any question I can translate them
Hope it helps you
Joaquín
Hi Joaquín
Thank you..for u help
Is it possible to export in MS office document not in PPT
if Not, Could you please translate the Macro to in English..
Thank you in advance
Rajesh.
Hi :
Well, PowerPoint is a part of MS Officce. This is the Translation
' Export to Power Point ...
Sub Export_QVDoc_2_PPT
' Retrieve the doc name to concatenate filename .PPT
QVDocName = ActiveDocument.GetPathName ' con el path completo
QVDocName = Mid(QVDocName, InStrRev(QVDocName, "\") + 1) ' eliminamos la parte del path
QVDocName = Left(QVDocName, InStrRev(QVDocName, ".qvw") - 1) ' eliminamos la extensión
' Edit date and time for filename
Now = Year(Date)
if Month(Date) < 10 then
Now = Now & "0" & Month(Date)
else
Now = Now & Month(Date)
end if
if Day(Date) < 10 then
Now = Now & "0" & Day(Date)
else
Now = Now & Day(Date)
end if
Now = Now & " "
if Hour(Time) < 10 then
Now = Now & "0" & Hour(Time)
else
Now = Now & Hour(Time)
end if
if Minute(Time) < 10 then
Now = Now & "0" & Minute(Time)
else
Now = Now & Minute(Time)
end if
if Second(Time) < 10 then
Now = Now & "0" & Second(Time)
else
Now = Now & Second(Time)
end if
' Construct filename PPT with qvw name + date + time
PPTDocName = "C:\TEMP\" & QVDocName & " " & Now & ".ppt"
' Check folder exists, if not create it
dim fsoObj
set fsoObj = CreateObject("Scripting.FileSystemObject")
if fsoObj.FolderExists("C:\TEMP")=false then
fsoObj.CreateFolder("C:\TEMP")
end if
Set fsoObj = Nothing
' Save active sheet
SheetID = ActiveDocument.ActiveSheet.GetProperties.SheetID
' Export qvw sheets as ppt slices
Set PPT_App = CreateObject("PowerPoint.Application")
PPT_App.Visible = True
Set PPT_Pres = PPT_App.Presentations.Add(True)
for i = 0 to ActiveDocument.NoOfSheets - 1
set ss= ActiveDocument.GetSheet(i)
SheetId = ss.GetProperties.SheetId
SheetId = Mid(SheetId, InStrRev(SheetId, "\") + 1)
If SheetId <> "SH00" and SheetId <> "SH01" then
Set PPT_Slide = PPT_Pres.Slides.Add(PPT_Pres.Slides.Count + 1, 12)
ActiveDocument.ActivateSheetByID ss.GetProperties.SheetId
ActiveDocument.GetApplication.WaitForIdle
ActiveDocument.GetApplication.Sleep 2000 '2000 milisegundos
ActiveDocument.ActiveSheet.CopyBitmapToClipboard
with PPT_Slide.Shapes.Paste
.LockAspectRatio = False
.Left = 0
.Top = 0
.Width=720
.Height=550
end with
end if
next
' Save the document and close PowerPoint
PPT_Pres.SaveAs PPTDocName
PPT_Pres.Close
PPT_App.Quit
Set PPT_Slide = Nothing
Set PPT_Pres = Nothing
Set PPT_App = Nothing
' Activate the saved sheet before the export
ActiveDocument.ActivateSheetByID SheetID
' Ending Information Message
Text = "Document " & chr(39) & PPTDOcName & chr(39) & " created correctly."
Retorno = MsgBox (Texto, vbInformation)
End Sub
Thank you JoaquínLR
Will try to implement dashboard using above macro.
Thanks,
Rajesh
Good luck