Dashboard to a MS Office Document

[Rajesh]

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

[avinashelite]

You can try with NPrinting ..it will help you to export all the objects easily to the word document ...

check this

How to Create Word Reports

[JoaquinLazaro]

' 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

[Rajesh]

Hi Avinash

Thank u for u r advice,but i am trying to achieve in QV as i don't have Nprinting Licence

[JoaquinLazaro]

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

[Rajesh]

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.

[JoaquinLazaro]

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

[Rajesh]

Thank you  JoaquínLR

Will try to implement dashboard using above macro.

Thanks,

Rajesh

[JoaquinLazaro]

Good luck