インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

アンケート　けっこうできてきた。

HTA,JScript

一度はまりだすと，小説より面白いですね。ひたすらアンケートのやつやってました。

Excelのブックをアップする手段がないので，物自身は上げれませんが，

概要とコードを上げてみます。

f:id:chemiphys:20190111005459p:plain

図のように，エクセルのシートに設問のデータを入れると，htaを作り出すという仕組みです。原因不明の上部の空白がいまのとこまだ解決できていませんが，使えそうなレベルになってきています。

Excelのコードを載せます。

・ポイントがあるとするならば，ADODB.Streamを使うことでUTF-8で書き出している点
・cssやJavaScript部分は共通なのでそのあたりをヘッダやフッタとしてExcelシートにのせておいて，それをどんどん張り付けてる点
・それらの一部を変更したい場合はreplaceで対応しています。

あんまり特別なことはしていないですね。けっこう簡単にやりたいことができました。。

はてなブログ，簡単なファイルアップロード機能あったら，さらに便利なのになぁ( ´Д｀)=3 

Sub MakeText()
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\" & "test.hta"
    
    Dim ADODBStream As Object
    Set ADODBStream = CreateObject("ADODB.Stream")
    With ADODBStream
        .Charset = "UTF-8"
        .Open
    End With
    
    Dim HeaderSheet As Worksheet: Set HeaderSheet = ThisWorkbook.Worksheets("ヘッダ")
    Dim FooterSheet As Worksheet: Set FooterSheet = ThisWorkbook.Worksheets("フッタ")
    Dim ConfigSheet As Worksheet: Set ConfigSheet = ThisWorkbook.Worksheets("アンケートシート")
    Dim 問題名配列文字列 As String, 問題タイプ配列文字列 As String
    
    Dim i, j, tmp, tmp2
    
    tmp = "[""No" & ConfigSheet.Cells(4, 1) & """"
    tmp2 = "[""" & ConfigSheet.Cells(4, 3) & """"
    i = 5
    Do While ConfigSheet.Cells(i, 1) <> ""
        tmp = tmp & ",""No" & ConfigSheet.Cells(i, 1) & """"
        tmp2 = tmp2 & ",""" & ConfigSheet.Cells(i, 3) & """"
        i = i + 1
    Loop
    問題名配列文字列 = tmp & "]"
    問題タイプ配列文字列 = tmp2 & "]"
    
    
    i = 1
    Do
        tmp = HeaderSheet.Cells(i, 1)
        If InStr(tmp, "【タイトル】") > 0 Then tmp = Replace(tmp, "【タイトル】", ConfigSheet.Cells(1, 2))
        If InStr(tmp, "【問題名配列】") > 0 Then tmp = Replace(tmp, "【問題名配列】", 問題名配列文字列)
        If InStr(tmp, "【問題タイプ配列】") > 0 Then tmp = Replace(tmp, "【問題タイプ配列】", 問題タイプ配列文字列)
        ADODBStream.writetext tmp, 1
        i = i + 1
        DoEvents
    Loop Until HeaderSheet.Cells(i, 1) = "--End--"
    
    '各要素
    i = 4
    Do While ConfigSheet.Cells(i, 1) <> ""
        ADODBStream.writetext "  <tr>", 1
        ADODBStream.writetext "    <td class=""setsumon"">" & ConfigSheet.Cells(i, 2) & "</td>", 1
        ADODBStream.writetext "  </tr>", 1
        ADODBStream.writetext "  <tr>", 1
        ADODBStream.writetext "    <td class=""kaitou"">", 1
                
        Select Case ConfigSheet.Cells(i, 3)
            
            Case Is = "radio"
                j = 6
                Do While ConfigSheet.Cells(i, j) <> ""
                    tmp = ConfigSheet.Cells(i, j)
                    ADODBStream.writetext "      <input type=""radio"" name=""No" & ConfigSheet.Cells(i, 1) & """ value=""" & tmp & """>" & tmp & "<br>", 1
                    j = j + 1
                Loop
            
            Case Is = "check"
                j = 6
                Do While ConfigSheet.Cells(i, j) <> ""
                    tmp = ConfigSheet.Cells(i, j)
                    ADODBStream.writetext "      <input type=""checkbox"" name=""No" & ConfigSheet.Cells(i, 1) & """ value=""" & tmp & """>" & tmp & "<br>", 1
                    j = j + 1
                Loop
            
            Case Is = "text"
                ADODBStream.writetext "      <input type=""text"" name=""No" & ConfigSheet.Cells(i, 1) & """ size=""45"" />", 1
            
            Case Is = "multi"
                ADODBStream.writetext "      <textarea name=""No" & ConfigSheet.Cells(i, 1) & """ rows=""5"" cols=""46"" ></textarea>", 1
        End Select
        
        ADODBStream.writetext "    </td>", 1
        ADODBStream.writetext "  </tr>", 1
        ADODBStream.writetext "", 1
        i = i + 1
    Loop
    
    i = 1
    Do
        ADODBStream.writetext FooterSheet.Cells(i, 1), 1
        i = i + 1
        DoEvents
    Loop Until FooterSheet.Cells(i, 1) = "--End--"
    
    ADODBStream.savetofile FileName, 2
    ADODBStream.Close
    
    
End Sub

excelファイルはアップできなくても，生成したコードぐらいは上げれるので，生成したコードを上げます。中身は推察されるはず

<!doctype html>
<html>
<head>
<meta charset="utf-8">
<title>テストアンケート</title>
  <style type="text/css">
    table{border-collapse: collapse;}
    table,tr,td{border: solid 2px black;}
    td.bango{text-align: center;background-color: black;font-weight: bold;color: white;width:15px}
    td.setsumon{padding-left: 5px;font-weight: bold;background-color: black;color: white;width:400px}
    td.kaitou{padding-left: 20px;background-color: antiquewhite}
  </style>
  <script>
　　　　
    function result(){
　　　　　　var mondaiName=["No1","No2","No3","No4"]
　　　　　　var mondaiType=["radio","check","text","multi"]
　　　　　　var html=[]
　　　　　　for (var i=0;i<mondaiName.length;i++){
　　　　　　　　html.push(i+1 + "_" + getData(mondaiName[i],mondaiType[i])+"◇")
　　　　　　}
　　　　　　document.getElementById("answer").innerHTML=html.join("")
　　　　}
　　　　
　　　　function getData(name,type){
　　　　　　switch(type){
　　　　　　　　case "radio":
　　　　　　　　case "check":
　　　　　　　　　　return getCheck(name);
　　　　　　　　　　break;
　　　　　　　　case "text":
　　　　　　　　case "multi":
　　　　　　　　　　return document.getElementsByName(name)[0].value.replace(/\r?\n/g,"■");
　　　　　　　　　　break;
　　　　　　}
　　　　}
　　　　
　　　　function getCheck(name){
      var CHECK=document.getElementsByName(name)
      var tmp=""
      for(var i=0;i<CHECK.length;i++){
        if(CHECK[i].checked) tmp+="," +CHECK[i].value
      }
      return tmp.substring(1)
    }
  </script>
</head>

<body>
　　<form name="form1">
  <table>

  <tr>
    <td class="setsumon">この中で一番好きな食べ物はどれか。</td>
  </tr>
  <tr>
    <td class="kaitou">
      <input type="radio" name="No1" value="カレー">カレー<br>
      <input type="radio" name="No1" value="ラーメン">ラーメン<br>
      <input type="radio" name="No1" value="うどん">うどん<br>
      <input type="radio" name="No1" value="そば">そば<br>
    </td>
  </tr>

  <tr>
    <td class="setsumon">好きなペットは何か。(複数えらんでいい)</td>
  </tr>
  <tr>
    <td class="kaitou">
      <input type="checkbox" name="No2" value="犬">犬<br>
      <input type="checkbox" name="No2" value="ネコ">ネコ<br>
      <input type="checkbox" name="No2" value="ハムスター">ハムスター<br>
    </td>
  </tr>

  <tr>
    <td class="setsumon">自分を動物に例えると。</td>
  </tr>
  <tr>
    <td class="kaitou">
      <input type="text" name="No3" size="45" />
    </td>
  </tr>

  <tr>
    <td class="setsumon">この変なアンケートについて感想をどうぞ。</td>
  </tr>
  <tr>
    <td class="kaitou">
      <textarea name="No4" rows="5" cols="46" ></textarea>
    </td>
  </tr>

  </table>
  <input type="button" href="#" value="送信する" onClick="result()"/>
  </form>

  <p>回答</p>
  <div id="answer"></div>
 </body>
</html>