Solved

Adding Charts and Graphs to HTA

Posted on 2013-06-04
4
943 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

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

FAQ pages provide a simple way for you to supply and for customers to find answers to the most common questions about your company. Here are six reasons why your company website should have a FAQ page
Color can increase conversions, create feelings of warmth or even incite people to get behind a cause. If you want your website to really impact site visitors, then it is vital to consider the impact color has on them.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

773 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