Solved

Adding Charts and Graphs to HTA

Posted on 2013-06-04
4
914 Views
Last Modified: 2013-06-18
I currently have an HTA which searches for specific item numbers or Vendor Name.  I am curious if it is possible to have the ability to show historical trends in data by using a line chart and or how many items a vendor has as compared to the total with maybe a pie chart.  Is this possible?  The code is below:

<html> 
<head> 
<HTA:APPLICATION 
APPLICATIONNAME="Purchasing Portal"
ID="Purchasing Portal"
border="normal" 
borderStyle="normal" 
caption="yes" 
icon="I:\BI-CEW\favicon2.ico" 
maximizeButton="yes" 
minimizeButton="yes" 
showInTaskbar="no" 
windowState="normal"
innerBorder="yes"
navigable="yes"
scroll="auto"
SINGLEINSTANCE="yes"
scrollFlat="yes" />

<br>
<title>Purchasing Portal -- Presented by ADS Solutions</title>
<center>
<TABLE BORDER="1" WIDTH="1000"><TR><TD>
<center><u><H1>Inventory Stock Position</H1></u></center>
<hr>
</center>
</head>

<style>

BODY
{
   background-color: Gainsboro;
   font-family: Cambria;
   font-size: 12pt;
   margin-top: 30px;
   margin-left: 5px;
   margin-right: 5px;
   margin-bottom: 30px;
}
button
{
   background-color: Steelblue;
   font-family: Cambria;
   font-size: 12pt;
   width: 100px;
   margin-left: 0px;
}
textarea
{
   color: white;
   font-family: Cambria;
   font-size: 11pt;
}
select
{
   font-family: Cambria;
   font-size: 10pt;
   width: 300px;  
   margin-left: 0px;
}
td
{
   color: default;
   font-family: Cambria;
   font-size: 11pt;
}
</style>

<script language=VBScript>  
' Copyright 2013, Chris Wright, cwright at adsinc dot com 
 
' Define menu items 
Const sMenuItems = "File,Edit,Help" 
 
' Define one submenu constant for each menu item as illustrated below 
' Each is a comma separated list in a single string 
Const sFile = "Open,Close,Save,Save As ...,Exit" 
Const sEdit = "Cut,Copy,Paste,Select All,Deselect All" 
Const sHelp = "Help, About" 
Const sHTML = "&nbsp;&nbsp;&nbsp;#sItem#&nbsp;&nbsp;&nbsp;" 
 
Dim dMenus, sMenuOpen 
 
sub Window_onload 
  Dim Rs
  Dim cn
  Dim objOption
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
	cn.Open
	Rs.Open "Select Distinct [Vendor Name] from [VPN Position$]", cn, 1, 3
  
  Do Until rs.EOF
	Set objOption = Document.createElement("OPTION")
	objOption.Text = rs.fields("Vendor Name")
	objOption.Value = rs.fields("Vendor Name")
	OptionChooser.Add(objOption)
	rs.MoveNext
    Loop  

  Dim entry 
  set dMenus = createObject("Scripting.Dictionary") 
  for each entry in Split(sMenuItems, ",") 
    menu.innerHTML = menu.innerHTML & "&nbsp;<span id=" & entry _ 
                   & " style='padding-bottom:2px' onselectstart=cancelEvent>&nbsp;" _ 
                   & entry & "&nbsp;</span>&nbsp;&nbsp;" 
    dMenus.Add entry, Split(eval("s" & entry), ",") 
  next 
  sMenuOpen = "" 


  window.resizeTo 1125,600
    strComputer = "."
    Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
    For Each objItem in colItems
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next
    intLeft = (intHorizontal - 1125) / 2
    intTop = (intVertical - 600) / 2
    window.moveTo intLeft, intTop
end sub 
 
Sub menu_onmouseover 
  
  clearmenu 
  with window.event.srcElement 
    if .parentElement.ID = "menu" then 
      .style.border = "thin outset" 
      .style.cursor = "arrow" 
    end if 
  end with 
 
end sub 
 
Sub menu_onmouseout 
 
  with window.event.srcElement 
    .style.border = "none" 
    .style.cursor = "default" 
  end with ' srcElement 
 
end sub 
 
Sub dropmenu_onmouseover 
  
  with window.event 
    .srcElement.style.cursor = "arrow" 
    .cancelbubble = true 
    .returnvalue = false 
  end with 
 
end sub 
 
sub SubMenuOver 
 
  with window.event.srcElement 
    if .ID = "dropmenu" then exit sub 
    .style.backgroundcolor = "darkblue" 
    .style.color = "white" 
    .style.cursor = "arrow" 
  end with 
 
end sub 
 
sub SubMenuOut 
 
  with window.event.srcElement 
    .style.backgroundcolor = "lightgrey" 
    .style.color = "black" 
    .style.cursor = "default" 
  end with 
 
end sub 
 
Sub menu_onclick 
Dim oEL, oItem 
 
  if sMenuOpen <> "" then exit sub 
  with window.event.srcElement 
    if .ID <> "menu" then 
      .style.border = "thin inset" 
      nLeft = .offsetLeft 
      ntop  = .offsetTop + replace(menu.style.Height, "px", "") - 5 
      sMenuOpen = trim(.innertext) 
      with dropmenu 
        with .style 
          .border = "thin outset" 
          .backgroundcolor = "lightgrey" 
          .position = "absolute" 
          .left = nLeft 
          .top = nTop 
          .width = "100px" 
          .zIndex = "101"  
        end with ' style 
        for each sItem in dMenus.Item(sMenuOpen) 
          set oEL = document.createElement("SPAN") 
          .appendChild(oEL) 
          with oEl 
            .ID = sItem 
            .style.height = "20px" 
            .style.width = dropmenu.style.width 
            .style.zIndex = "102" ' added 28 June 2010 
            .innerHTML = Replace(sHTML, "#sItem#", trim(sItem)) 
            set .onmouseover = getRef("SubMenuOver") 
            set .onmouseout = getRef("SubMenuOut") 
            set .onclick = getRef("SubMenuClick") 
            set .onselectstart = getRef("cancelEvent") 
          end with ' child node 
          set oEL = document.createElement("BR") 
          .appendChild(oEL) 
        next 
      end with ' dropmenu 
    end if 
  end with ' srcEement 
 
end sub 
 
sub cancelEvent 
  window.event.returnValue = false 
end sub ' cancelEvent 
 
sub clearmenu 
 
  dropmenu.innerHTML = "" 
  dropmenu.style.border = "none" 
  dropmenu.style.backgroundcolor = "transparent" 
  if sMenuOpen <> "" then 
    document.getElementByID(sMenuOpen).style.border = "none" 
    sMenuOpen = "" 
  end if 
end sub 
 
' ###################  IMPORTANT  ################### 
' Code to accomplish each submenu item defined above 
' Can be as simple as a subroutine call 
' 
Sub SubMenuClick 
 
  sItem = trim(window.event.srcElement.innerText) 
  clearmenu 
  Select Case lcase(sItem) 
    case "open" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "close" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "save" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "save as ..." 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "exit" 
      window.close 
    case "cut" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "copy" 
    case "paste" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "select all" 
      msgbox "Sorry, " & sItem & " is not implemented" 
    case "deselect all" 
      msgbox "Sorry, " & sItem & " is not implemented"     
    case "help" 
      msgbox "Help under construction", vbOKOnly + vbInformation, "Help" 
    case "about" 
      msgbox "Copyright, 2013" & vbCRLF & "Chris wright"_ 
              & vbCRLF & "Released for Purchasing Only",_ 
              vbOKOnly + vbInformation, "About Menu" 
    case else ' catch all for undefined menu items 
      msgbox "Sorry, " & sItem & " is not implemented" 
  end Select 
 
end sub 
 
Sub RunScript
    Location.Reload(True)
End Sub

sub ReturnRows
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] =""" & txtFilter.value & """", cn, 1, 3
	strData = "<table width=""100%"" border=""2"" cellpadding=""1""<caption>Results:</caption"">"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			strRow = strRow & "<td>" & fld.value & "</td>"
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
end sub

sub FuzzySearch	
	Dim cn
	Dim Rs
	Dim strData
	Dim strRow
	Dim fld
	Set Rs = CreateObject("ADODB.Recordset")
	Set cn = CreateObject("ADODB.connection")
	cn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\Chris Wright\Chris Wright\Daily Reports\Stock Position Reports\Daily Stocking Position.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"  'Persist Security Info=False;"
	cn.Open
	Rs.Open "Select * from [VPN Position$] Where [Vendor Part Number] Like '%" & txtFilter.value & "%'", cn, 1, 3
	strData = "<table width=""100%"" border>"
        if not rs.eof then
	  strData = strData & "<tr>"
          strRow = ""
          For each fld in rs.fields
            strRow = strRow & "<th>" & fld.name & "</th>"
          Next
          strData = strData & strRow & "</tr>"
        end if 
	do until Rs.EOF
	  strRow = "<tr>"
	  For Each fld in Rs.Fields
		if fld.name = "MAX Ordered Qty" then
			strRow = strRow & "<td class=""mono"">" & fld.value & "</td>"
		else
			strRow = strRow & "<td>" & fld.value & "</td>"
		end if
	  Next
	  strData = strData & strRow & "</tr>"
	  Rs.MoveNext
	Loop
	DataArea.InnerHTML = strData & "</table>"
end sub
</script> 

<!--Page layout follows--> 
<body onmouseover=menu_onmouseover style="font:14pt Cambria"> 
<div id=menu style="position:absolute;left:0;top:0;width:110%;height:23px; 
                    padding-top:2px;background-color:lightgrey; 
                    font:normal 12pt Cambria;z-Index:100"> 
</div> 
<span id=dropmenu style="font:normal 10pt Cambria"></span>

<fieldset>
<b><legend>Search:</legend></b><p>
<b>Part Number: </b> <input type="text" name="txtFilter" size="40"><br><br>
<b>Vendor Name: <select size="1" name="OptionChooser" onChange="TestSub"></select>

<br><br>
<input id=runbutton  class="button" type="button" value="Search" name="run_button"  onClick="ReturnRows">
<input id=runbutton  class="button" type="button" value="Fuzzy Search" name="run_button"  onClick="FuzzySearch">
<input id=runbutton  class="button" type="button" value="Refresh" name="run_button"  onClick="RunScript">
<br>
</fieldset>
<hr>
<span id=DataArea></span>
<span id=msg style="z-Index:10"></span> 
</body> 
</html>

Open in new window

0
Comment
Question by:Christopher Wright
4 Comments
 

Accepted Solution

by:
Christopher Wright earned 0 total points
ID: 39230447
Bump.  Any help out there?
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
ID: 39258083
I saw this when looking at related questions for your hta app.  
You will have a lot more flexibility to do trending and graphs if you move it to a web app.

What was the reason you decided on a hta?
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

JavaScript has plenty of pieces of code people often just copy/paste from somewhere but never quite fully understand. Self-Executing functions are just one good example that I'll try to demystify here.
Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
The viewer will learn the benefit of using external CSS files and the relationship between class and ID selectors. Create your external css file by saving it as style.css then set up your style tags: (CODE) Reference the nav tag and set your prop…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now