Hello Team,
I need one help. I have written one macro which is producing the dashboards in form of images and saving it as an name_id_date.
but now when i exporting the images i am getting the mismatch in the name and data of dashboard. i.e. it is saving the dashboard by giving the other name. below is my code:
Sub Export_Report
ActiveDocument.Sheets("SH01").Activate
sPCode = ActiveDocument.Variables("vPCode").GetContent().String
ExpPath = ActiveDocument.Variables("vExPath").GetContent().String
ActiveDocument.ClearAll 'The sheets need to be cleared'
'msgbox sPCode
ActiveDocument.Fields("PRACTICE_CODE").select sPCode
sPCode=left(sPCode,3)
'Check if selections have been made, multiple selections are not OK, thus the LEN(SPCode) check
'The month will most likely be redundant
If lEN(sPCode) <> 3 Then
msgbox("You have to select a Practice Code. No reports will be written")
EXIT SUB
End If
'Get the possible values for the current selection in ID!!?
set mySelections = ActiveDocument.Fields("ID").GetPossibleValues(999999)
set myName = ActiveDocument.Fields("EMPLOYEE_NAME").GetPossibleValues(999999)
Dim loadDate
Dim i
Dim Fieldvalue
Dim Filename
dim empName
dim empid
set empid=ActiveDocument.Variables("perId")
empidval=empid.GetContent.String
'set aa=GetFieldSelections("ID")
'msgbox empidval
ReportPeriod = ActiveDocument.Variables("vReferenceDate").GetContent().String
FileName = ExpPath & SPCode & "\"
result1 = msgbox("All files in" & Filename & " will be deleted. Continue? " ,vbYesNoCancel,"Continue?")
If result1 = 7 Or result1 = 2 Then
EXIT SUB
End If
'DeleteFiles(FileName)
result2 = msgbox("Reports for" & mySelections.Count & " employees will be written for practice " & SPCode & ". Continue? " ,vbYesNoCancel,"Continue?")
If result2 = 7 Or result2 = 2 Then
EXIT SUB
End If
'Set up the document for export! Yes this is needed
FieldValue = mySelections.Item(0).text
ActiveDocument.Fields("ID").select FieldValue
empName=myName.Item(0).Text
ActiveDocument.Fields("EMPLOYEE_NAME").select empName
'Message box below is needed, it is a workaround !!! Can not be removed since it refreshes the sheet.
'Otherwise, the first employee will get the report of the next comming in the loop
ActiveDocument.Sheets("SH01").SheetObjects("CH49").Activate
for i = 0 to mySelections.Count - 1
'for i = 0 to 50
'dim FieldValue
'dim mnth
FieldValue = mySelections.Item(i).text
empName = myName.Item(i).text
'If an employeeid does not exist in month then a file is still written
ActiveDocument.Fields("ID").select FieldValue
'For some reason this has to stay inside the loop, hard setting???
ActiveDocument.Fields("PRACTICE_CODE").select SPCode
Application.Refresh
'ActiveDocument.ShowPopup "Ok", 10000
ActiveDocument.Sheets("SH01").SheetObjects("CH03").Activate
ActiveDocument.GetApplication.Waitforidle 200000
ActiveDocument.Sheets("SH01").SheetObjects("CH164").Activate
ActiveDocument.GetApplication.Waitforidle 200000
ActiveDocument.Sheets("SH01").SheetObjects("CH136").Activate
ActiveDocument.GetApplication.Waitforidle 200000
Application.Refresh
'ActiveDocument.GetApplication.Sleep 4000
'Concatenate string of employee id (the Fieldevalue), Employee Name (emp_name), and the timestmp
'ActiveDocument.Sheets("SH01").ExportBitmapToFile FileName & FieldValue & "_" & emp_name & "_" & ReportPeriod & ".png"
Application.Refresh
ActiveDocument.GetApplication.Waitforidle 400000
'MsgBox("Click Ok")
'msgbox FieldValue
ActiveDocument.Sheets("SH01").ExportBitmapToFile FileName & empName &"-"& FieldValue &"_" & ReportPeriod & ".png"
ActiveDocument.GetApplication.Waitforidle 400000
Next
msgbox(i & " number of reports have been written to " & FileName)
End Sub
Regards,
Suryakant
