UCSS_TIPS_AND_SAMPLES
http://w.atwiki.jp/enusii/
UCSS_TIPS_AND_SAMPLESja2012-02-28T14:07:35+09:001330405655メニュー2
https://w.atwiki.jp/enusii/pages/3.html
**更新履歴
#recent(20)
&link_editmenu2(text=ここを編集)
2012-02-28T14:07:35+09:001330405655JAVA/webページを取得する
https://w.atwiki.jp/enusii/pages/17.html
** URLからコンテンツを取得します。
取得するにはURLクラスを使用します。~
charsetをしくじると化けます^^;~
サンプルクラスはURLからStringでコンテンツを取得します。~
とりあえず10回ぐらいリトライ機能もあります。~
import java.io.BufferedReader;
import java.io.InputStreamReader;
import java.net.URL;
import java.net.URLConnection;
public class UrlUtil {
/**
* URLにより、コンテンツを取得する
* 取得したコンテンツはString で返す
* @param url
* @return コンテンツ
*/
public static String getUrl2String(String url){
return getUrl2String(url, 0);
}
/**
* URLにより、コンテンツを取得する
* 取得したコンテンツはString で返す
* @param url
* @param errcnt
* @return コンテンツ
*/
public static String getUrl2String(String url, int errcnt){
StringBuffer sb = new StringBuffer();
try {
URL url2 = new URL(url);
URLConnection conn = url2.openConnection();
String charset = conn.getContentType();
charset = charset.substring(charset.indexOf("=") + 1, charset.length() );
BufferedReader r = new BufferedReader(
new InputStreamReader(
conn.getInputStream(), charset ));
char cha[] = new char[4096];
int n;
while((n = r.read(cha, 0, cha.length)) != -1){
String s = new String(cha,0,n);
sb.append( s );
// System.out.print(s);
}
} catch (Exception e){
e.getStackTrace();
if(errcnt < 10){
errcnt++;
getUrl2String(url, errcnt);
}
}
return sb.toString();
}
}
- bbb -- あああ (2011-12-19 15:22:51)
#comment()
2011-12-19T15:22:51+09:001324275771C/PropertyInfoからの型チェック
https://w.atwiki.jp/enusii/pages/25.html
Type t = p.PropertyType;
if (typeof(decimal) == t || typeof(decimal?) == t)
{
ret = decimal.Parse(v);
}
else if (typeof(int) == t || typeof(int?) == t)
{
ret = int.Parse(v);
}
else if (typeof(long) == t || typeof(long?) == t)
{
ret = long.Parse(v);
}
else if (typeof(DateTime) == t)
{
ret = DateTime.Parse(v);
}
else if (typeof(bool) == t)
{
}
else
{
ret = v;
}
2010-04-14T14:21:34+09:001271222494VBA/コンテキストメニューを作成する
https://w.atwiki.jp/enusii/pages/24.html
#contents
**コンテキストメニューを作成する
まずはワークブックオープン時に呼び出すようにしておきます
Private Sub Workbook_Open()
Call menu_create
End Sub
メニューを作るロジックを作成
Public Sub menu_create()
'コンテキストメニューの追加
Application.CommandBars("Cell").Controls.Item("切り取り(&T)").BeginGroup = True
'区切り線を追加しています。
Dim cbc_cell As CommandBarControl
Set cbc_cell = CommandBars("Cell").Controls.add(Type:=msoControlButton, before:=1, Temporary:=True)
With cbc_cell
.Caption = "選択セル_名称自動取得"
'.FaceId = 50
.OnAction = "選択セル_名称自動取得XML"
End With
Set cbc_cell = CommandBars("Cell").Controls.add(Type:=msoControlButton, before:=1, Temporary:=True)
With cbc_cell
.Caption = "選択セル_名称リスト自動取得"
'.FaceId = 50
.OnAction = "選択セル_名称リスト自動取得"
End With
End Sub
ワークブッククローズ時はメニューを戻すようにしておきます
Private Sub Auto_Close()
Application.ScreenUpdating = False
'デフォルトのEXCELメニューバーに戻す
On Error Resume Next
CommandBars("Cell").Controls("切り取り(&T)").BeginGroup = False
On Error GoTo 0
End Sub
#comment()
2008-06-25T18:13:06+09:001214385186VBA/メニューを作成する
https://w.atwiki.jp/enusii/pages/23.html
#contents
**メニューを作成する
まずはワークブックオープン時に呼び出すようにしておきます
Private Sub Workbook_Open()
Call menu_create
End Sub
メニューを作るロジックを作成
Public Sub menu_create()
Dim bars As CommandBar ' 現在のEXCELメニューバー
Dim bar_control As CommandBarControl ' ユーザーメニュー追加後のメニューバー
Dim bar_botton As CommandBarButton ' ユーザーメニューに追加した項目ボタン
'メニューに「ユーザーメニュー」を追加
Set bars = CommandBars.ActiveMenuBar
Set bar_control = bars.Controls.add _
(Type:=msoControlPopup, _
Temporary:=True, _
ID:=1)
With bar_control
.BeginGroup = True
.Caption = "マクロメニュー"
.Visible = True
.Enabled = True
End With
' 「ユーザーメニュー」に、個々のサブメニューを追加していく
Set bar_botton = bar_control.Controls _
.add(Type:=msoControlButton, Temporary:=True)
bar_botton.Caption = "全シート_ヘッダフッタ設定"
bar_botton.Style = msoButtonCaption
bar_botton.OnAction = "全シート_ヘッダフッタ設定"
Set bar_botton = bar_control.Controls _
.add(Type:=msoControlButton, Temporary:=True)
bar_botton.Caption = "全シート_A1フォーカス設定"
bar_botton.Style = msoButtonCaption
bar_botton.OnAction = "全シート_A1フォーカス設定"
End Sub
ワークブッククローズ時はメニューを戻すようにしておきます
Private Sub Auto_Close()
Application.ScreenUpdating = False
'デフォルトのEXCELメニューバーに戻す
On Error Resume Next
CommandBars.ActiveMenuBar.Reset
On Error GoTo 0
End Sub
#comment()
2008-06-25T18:10:13+09:001214385013JAVA/ちょっとした自作関数
https://w.atwiki.jp/enusii/pages/22.html
あるとそこそこ便利?な関数
#contents
----
**不要小数点削除関数
/**
* 小数点を消すことができれば消す.
*
* <PRE>
* String s = "";
* "1.0";
* tem.out.println(s + "→" + Conv2Prop.delScale(s));
* "1.001";
* tem.out.println(s + "→" + Conv2Prop.delScale(s));
* "1";
* tem.out.println(s + "→" + Conv2Prop.delScale(s));
* "001.0";
* tem.out.println(s + "→" + Conv2Prop.delScale(s));
* "100";
* tem.out.println(s + "→" + Conv2Prop.delScale(s));
* </PRE>
*
* @param str 文字列(数値でない場合は何も行わない)
* @return 変換後文字列数値
*/
public static String delScale(String str){
if(isNumeric(str)){
BigDecimal bd = new BigDecimal(str);
if(bd.doubleValue() == bd.intValue()){
return bd.setScale(0).toPlainString();
}
}
return str;
}
**数値チェック関数
/**
* 数値型となりえるか.
*
* @param str
* @return true:数値型となりえる false:数値型となりえない
*/
public static boolean isNumeric(String str){
try{
new BigDecimal(str);
return true;
}
catch (Exception e) {
return false;
}
}
**ブランクチェック関数
NULLと空文字を同一視
/**
* ブランクチェック.
*
* @param str
* @return true:null、もしくはブランク false:値あり
*/
public static boolean isNull(String str){
return (str == null || "".equals(str));
}
**replaceAll自作
/**
* 置換関数.<br>
* ※java1.3にはreplaceAllが無い為、自作.<br>
*
* <PRE>
* value="AAAABBCCCDDDAAABCDDDCC",old_str="B",new_str="BBB" ret="AAAABBBBBBCCCDDDAAABBBCDDDCC"
* value="AABBCC",old_str="B",new_str="BBB" ret="AABBBBBBCC"
* value="AABBCC",old_str="BB",new_str="BBB" ret="AABBBCC"
* value="AABBCC",old_str="BBB",new_str="BBB" ret="AABBCC"
* value="AABBCCBB",old_str="BB",new_str="" ret="AACC"
* value="AABBCC",old_str="BB",new_str="" ret="AACC"
* value="AABBCC",old_str="",new_str="" ret="AABBCC"
* value="AA.BB&C&C",old_str="&",new_str="&" ret="AA.BB&C&C"
* value="AA.BB&C&C",old_str=".",new_str=" " ret="AA BB&C&C"
* value="AA BB C&C",old_str=" ",new_str=" " ret="AA BB C&C"
* </PRE>
* @param value 対象文字列
* @param old_str 置換旧文字列
* @param new_str 置換新文字列
* @return 置換後文字列
*/
public static String replaceAll(String value, String old_str, String new_str){
//nullチェック
if(value == null || old_str == null || "".equals(old_str)){
return value;
}
StringBuffer ret = new StringBuffer();
int old_len = old_str.length();
int from_index = 0;
int index = 0;
boolean loop_flg = true;
while(loop_flg){
index = value.indexOf(old_str, from_index);
if(-1 < index){
ret.append(value.substring(from_index, index));
ret.append(new_str);
from_index = index + old_len;
}
else{
ret.append(value.substring(from_index));
loop_flg = false;
}
}
return ret.toString();
}
#comment()
2008-06-25T17:23:35+09:001214382215VBA/XML/Mapクラスを作ってみる①
https://w.atwiki.jp/enusii/pages/21.html
#contents
----
**Mapクラスサンプル
VB、VBAにはMapが無いので、XMLユーティリティクラスを使用して自作してみました。
これはString版
#ref(XmlCustomMap.cls)
'Stringを格納できるMAP
Option Explicit
Const ELE_XML = "xml"
Const ELE_MAP = "map"
Const ATT_KEY = "key"
Const XPATH_MAP = ELE_XML + "/" + ELE_MAP
Private g_xml As XMLUtilClass
Public Sub putValue(ByVal x_key As String, ByVal x_value As String)
Dim l_xpath As String
Dim l_key As String
l_key = x_key
'XMLクラスが無ければ生成
If g_xml Is Nothing Then
newXml
End If
'null or ブランク は文字列"NULL"として扱う
If IsNull(l_key) = True Or l_key = "" Then
l_key = "NULL"
End If
'DELTE→INSERT
'要素削除
l_xpath = XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']"
g_xml.getNode (l_xpath)
g_xml.removeNode
'ルートへ移動
g_xml.getNode (ELE_XML)
'要素追加
Call g_xml.addElement(ELE_MAP)
'属性追加
Call g_xml.setAttributeEx(ATT_KEY, l_key)
'要素の値をセット
Call g_xml.setNodeValue(x_value)
End Sub
Public Function getValue(ByVal x_key As String) As String
Dim l_key As String
Dim l_xpath As String
l_key = x_key
If g_xml Is Nothing Then
getValue = ""
Exit Function
End If
'null or ブランク は文字列"NULL"として扱う
If IsNull(l_key) = True Or l_key = "" Then
l_key = "NULL"
End If
l_xpath = XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']"
g_xml.getNode (l_xpath)
getValue = g_xml.getNodeValueEx
End Function
Public Function containsKey(ByVal x_key As String) As Boolean
Dim l_key As String
Dim l As Long
l_key = x_key
'XMLクラスが無ければfalse
If g_xml Is Nothing Then
Exit Function
End If
'null or ブランク は文字列"NULL"として扱う
If IsNull(l_key) = True Or l_key = "" Then
l_key = "NULL"
End If
'XPathからセレクションノードを取得
containsKey = (0 < g_xml.getSelectionNode(XPATH_MAP + "[@" + ATT_KEY + "='" + l_key + "']").Length)
End Function
Public Function size() As Long
'XMLクラスが無ければ0
If g_xml Is Nothing Then
size = 0
Exit Function
End If
'XPathからセレクションノードを取得
size = g_xml.getSelectionNode(XPATH_MAP).Length
End Function
'keyをリストにして返す
Public Function getKeyList() As XmlCustomList
Dim l_xpath As String
Dim l_list As New XmlCustomList
Dim n() As String
Dim i As Integer
l_xpath = XPATH_MAP
If g_xml Is Nothing Then Exit Function
g_xml.getSelectionNode (l_xpath)
'全取得ノード分ループ
Do While (Not g_xml.getNextNode() Is Nothing)
'属性を全て取得
n = g_xml.getAttributeValuesEx
For i = 0 To UBound(n)
l_list.add n(i)
Next
Loop
Set getKeyList = l_list
End Function
Private Sub newXml()
'XMLクラス
Set g_xml = New XMLUtilClass
'XML作成
g_xml.createNewXML
Call g_xml.addElement("xml")
End Sub
Private Sub Class_Terminate()
Set g_xml = Nothing
End Sub
#comment()
2008-06-24T18:44:52+09:001214300692VBA/XML/汎用XMLユーティリティクラスを作る
https://w.atwiki.jp/enusii/pages/19.html
#contents
----
**汎用的なXMLユーティリティクラスを作成してみる
XMLは便利だけどオブジェクトが沢山あって面倒~
なので汎用的なクラスを作ってみる~
#ref(XMLUtilClass.cls)
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "XMLUtilClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private g_XMLDocument As New DOMDocument50
Private g_currentNode As IXMLDOMNode
Private g_xml_path As String
Private g_xpath_node As String
Private g_xml_selection As IXMLDOMSelection
'attribute のセット
Public Sub setAttributeElement(ele As IXMLDOMElement, name As String, value As String)
Dim att As MSXML2.IXMLDOMAttribute
Set att = g_XMLDocument.createAttribute(name)
att.Text = value
ele.setAttributeNode att
Set att = Nothing
End Sub
'attribute のセット
Public Sub setAttributeEx(name As String, value As String)
Call setAttribute(g_currentNode, name, value)
End Sub
'attribute のセット(旧版)
Private Sub setAttribute_OLD(node As IXMLDOMNode, name As String, value As String)
'attributeがある場合は上書き
If node Is Nothing Then Exit Sub
Dim i As Integer
Dim n As IXMLDOMNode
For i = 0 To node.Attributes.Length - 1
If name = node.Attributes(i).baseName Then
node.Attributes(i).Text = value
Exit Sub
End If
Next
'無い場合は作成
Call addAttribute(node, name, value)
End Sub
'attribute のセット
Public Sub setAttribute(node As IXMLDOMNode, name As String, value As String)
Dim n As IXMLDOMNode
'attributeがある場合は上書き
If node Is Nothing Then Exit Sub
Set n = node.Attributes.getNamedItem(name)
If n Is Nothing Then
'無い場合は作成
Call addAttribute(node, name, value)
Else
n.Text = value
End If
Set n = Nothing
End Sub
'attribute の追加
Public Sub addAttribute(node As IXMLDOMNode, name As String, value As String)
If node Is Nothing Then Exit Sub
Dim att As IXMLDOMNode
Set att = g_XMLDocument.createAttribute(name)
att.Text = value
Dim dmy As Object
Set dmy = node.Attributes.setNamedItem(att)
Set att = Nothing
Set dmy = Nothing
End Sub
'attribute の追加
Public Sub addAttributeEx(name As String, value As String)
Call addAttribute(g_currentNode, name, value)
End Sub
'attribute の削除
Public Sub removeAttributes(node As IXMLDOMNode, name As String)
If node Is Nothing Then Exit Sub
node.Attributes.removeNamedItem (name)
End Sub
'attribute の削除
Public Sub removeAttributesEx(name As String)
Call removeAttributes(g_currentNode, name)
End Sub
'attribute の数
Public Static Function sizeAttributes(node As IXMLDOMNode) As Long
sizeAttributes = 0
If node Is Nothing Then Exit Function
sizeAttributes = node.Attributes.Length
End Function
'attribute の数
Public Static Function sizeAttributesEx() As Long
sizeAttributesEx = sizeAttributes(g_currentNode)
End Function
'attribute が存在するか(旧版)
Private Static Function containsKeyAttribute_OLD(node As IXMLDOMNode, name As String) As Boolean
containsKeyAttribute_OLD = False
If node Is Nothing Then Exit Function
Dim i As Integer
For i = 0 To node.Attributes.Length - 1
If name = node.Attributes(i).baseName Then
containsKeyAttribute_OLD = True
Exit Function
End If
Next
End Function
'attribute が存在するか
Public Static Function containsKeyAttribute(node As IXMLDOMNode, name As String) As Boolean
containsKeyAttribute = False
If node Is Nothing Then Exit Function
containsKeyAttribute = (Not node.Attributes.getNamedItem(name) Is Nothing)
End Function
'attribute が存在するか
Public Function containsKeyAttributeEx(name As String) As String
containsKeyAttributeEx = containsKeyAttribute(g_currentNode, name)
End Function
'attribute のゲット
Public Static Function getAttributeValue(node As IXMLDOMNode, name As String) As String
Dim n As IXMLDOMNode
Dim s As String
If node Is Nothing Then Exit Function
Set n = node.Attributes.getNamedItem(name)
If n Is Nothing Then
s = ""
Else
s = n.Text
End If
Set n = Nothing
getAttributeValue = s
End Function
'attribute のゲット(旧版)
Public Static Function getAttributeValue_OLD(node As IXMLDOMNode, name As String) As String
If node Is Nothing Then Exit Function
Dim i As Integer
For i = 0 To node.Attributes.Length - 1
If name = node.Attributes(i).baseName Then
getAttributeValue_OLD = node.Attributes(i).Text
Exit Function
End If
Next
End Function
'attribute のゲット
Public Function getAttributeValueEx(name As String) As String
getAttributeValueEx = getAttributeValue(g_currentNode, name)
End Function
'attributeの値のゲット(名)
Public Function getAttributeNames(node As IXMLDOMNode) As String()
Dim ret() As String
If node Is Nothing Then Exit Function
Dim i As Integer
For i = 0 To node.Attributes.Length - 1
ReDim Preserve ret(i)
ret(i) = node.Attributes(i).baseName
Next
getAttributeNames = ret
End Function
'attributeの値のゲット(名)
Public Function getAttributeNamesEx() As String()
getAttributeNamesEx = getAttributeNames(g_currentNode)
End Function
'attributeの値のゲット(配列)
Public Function getAttributeValues(node As IXMLDOMNode) As String()
Dim ret() As String
If node Is Nothing Then Exit Function
Dim i As Integer
For i = 0 To node.Attributes.Length - 1
ReDim Preserve ret(i)
ret(i) = node.Attributes(i).Text
Next
getAttributeValues = ret
End Function
'attributeの値のゲット(配列)
Public Function getAttributeValuesEx() As String()
getAttributeValuesEx = getAttributeValues(g_currentNode)
End Function
'XMLファイルのロード
Public Sub loadXML(x_xml_path As String)
g_xml_path = x_xml_path
Set g_XMLDocument = New DOMDocument50
g_XMLDocument.async = False
g_XMLDocument.load (x_xml_path)
If g_XMLDocument.parsed = False Then
MsgBox "ファイル形式がXMLでありません。"
End If
'カレントノードにセット
Set g_currentNode = g_XMLDocument
End Sub
'XMLを新規作成する
Public Function createNewXML()
Dim s As String
s = "<?xml version=""1.0"" encoding=""UTF-8""?>"
g_XMLDocument.loadXML s
'カレントノードにセット
Set g_currentNode = g_XMLDocument
End Function
'XMLファイルのセーブ
Public Sub save(x_path)
If IsNull(x_path) = True Or x_path = "" Then
x_path = g_xml_path
End If
g_XMLDocument.save x_path
End Sub
'XMLDocumentからXPathによりノードを取得し、カレントノードに登録する
'状況に応じてgetSelectionNodeと使い分けると便利
Public Function getNode(x_xpath As String) As IXMLDOMNode
Set g_xml_selection = g_XMLDocument.selectNodes(x_xpath)
Set g_currentNode = g_xml_selection.NextNode
Set getNode = g_currentNode
End Function
'カレントノードを取得する
Public Function getCurrentNode() As IXMLDOMNode
Set getCurrentNode = g_currentNode
End Function
'XMLDocumentからXPathによりセレクションノードを取得し、クラスのメンバにもセットする
'状況に応じてgetNodeと使い分けると便利
'※セレクションに移動したくない場合等に使用
Public Function getSelectionNode(x_xpath As String) As IXMLDOMSelection
Set g_xml_selection = g_XMLDocument.selectNodes(x_xpath)
Set getSelectionNode = g_xml_selection
End Function
'セレクションノードをクラスのメンバにセットする
Public Sub setSelectionNode(x_xml_selection As IXMLDOMSelection)
Set g_xml_selection = x_xml_selection
End Sub
'次のノードを取得し、カレントノードに登録する
Public Function getNextNode() As IXMLDOMNode
Set g_currentNode = g_xml_selection.NextNode
Set getNextNode = g_currentNode
End Function
'ノードをカレントノードにセットする
Public Sub setNode(x_node As IXMLDOMNode)
Set g_currentNode = x_node
End Sub
'カレントノードにエレメントを追加&移動(子ノードを追加)
Public Function addElement(x_element_name As String)
Dim xml_element As IXMLDOMElement
Set xml_element = g_XMLDocument.createElement(x_element_name)
g_currentNode.appendChild xml_element
Set g_currentNode = xml_element
Set xml_element = Nothing
End Function
'カレントノード(エレメント)に値を記述する
Public Function setNodeValue(x_value As String)
g_currentNode.Text = x_value
End Function
'カレントノード(エレメント)の値を取得する
Public Function getNodeValueEx() As String
If Not g_currentNode Is Nothing Then
getNodeValueEx = g_currentNode.Text
End If
End Function
'カレントノード(エレメント)の値を取得する
Public Function getNodeValue(node As IXMLDOMNode) As String
If Not node Is Nothing Then
getNodeValue = node.Text
End If
End Function
'親ノードを取得&移動
Public Function getParentNode() As IXMLDOMNode
Set g_currentNode = g_currentNode.parentNode
Set getParentNode = g_currentNode
End Function
'カレントノードを削除して親ノードへ移動する
Public Function removeNode()
If g_currentNode Is Nothing Then
Exit Function
End If
Dim parentNode As IXMLDOMNode
Set parentNode = g_currentNode.parentNode
Call parentNode.removeChild(g_currentNode)
Set g_currentNode = parentNode
Set parentNode = Nothing
End Function
'子ノードを取得
Public Function getChildNodes() As IXMLDOMNodeList
If g_currentNode Is Nothing Then
Exit Function
End If
Set getChildNodes = g_currentNode.childNodes
End Function
Public Function getXML() As String
getXML = g_XMLDocument.xml
End Function
'ターミネイト
Private Sub Class_Terminate()
Set g_XMLDocument = Nothing
Set g_currentNode = Nothing
Set g_xml_selection = Nothing
End Sub
'属性をmapに格納します
Public Function getAttributeMapEx() As XmlCustomMap
Set getAttributeMapEx = getAttributeMap(g_currentNode)
End Function
'属性をmapに格納します
Public Function getAttributeMap(node As IXMLDOMNode) As XmlCustomMap
Dim l_att() As String
Dim l_map As New XmlCustomMap
Dim i As Integer
If Not node Is Nothing Then
l_att = getAttributeNames(node)
For i = 0 To UBound(l_att)
Call l_map.putValue(l_att(i), getAttributeValue(node, l_att(i)))
Next
End If
Set getAttributeMap = l_map
End Function
----
**XMLユーティリティクラスのテスト
***test1(XMLの作成)
Sub xml_test()
Dim cls As New XMLUtilClass
'XML新規作成
cls.createNewXML
'要素追加&移動
Call cls.addElement("testelement1")
'要素追加&移動
Call cls.addElement("testelement2")
'要素の値をセット
Call cls.setNodeValue("nodevalue1")
'属性追加
Call cls.setAttributeEx("testname", "testvalue")
Call cls.setAttributeEx("testname2", "5")
'要素親へ移動
Call cls.getParentNode
'要素追加&移動
Call cls.addElement("testelement2")
'要素の値をセット
Call cls.setNodeValue("nodevalue2")
'属性追加
Call cls.setAttributeEx("testname", "testvalue")
Call cls.setAttributeEx("testname2", "10")
'XMLを保存
cls.save ("C:\temp\test.xml")
'開放
Set cls = Nothing
MsgBox "おわり"
End Sub
''結果(test.xml)''
<testelement1>
<testelement2 testname="testvalue" testname2="5">nodevalue1</testelement2>
<testelement2 testname="testvalue" testname2="10">nodevalue2</testelement2>
</testelement1>
#hr
***test2(属性の全取得)
Sub xml_test2()
Dim cls As New XMLUtilClass
Dim n() As String
Dim v() As String
Dim i As Integer
'XMLファイルをロード
cls.loadXML ("C:\temp\test.xml")
'XPathからセレクションノードを取得
cls.getSelectionNode ("testelement1/testelement2")
'全取得ノード分ループ
Do While (Not cls.getNextNode() Is Nothing)
'属性を全て取得
n = cls.getAttributeNamesEx
v = cls.getAttributeValuesEx
For i = 0 To UBound(n)
Debug.Print n(i) & ":" & v(i)
Next
Loop
Set cls = Nothing
MsgBox "おわり"
End Sub
''結果''
testname:testvalue
testname2:5
testname:testvalue
testname2:10
#hr
***test3(属性の一部取得)
Sub xml_test3()
Dim cls As New XMLUtilClass
'XMLファイルをロード
cls.loadXML ("C:\temp\test.xml")
'XPathからセレクションノードを取得
cls.getSelectionNode ("//testelement2[number(@testname2)>8 and contains(@testname,'value')]")
'全取得ノード分ループ
Do While (Not cls.getNextNode() Is Nothing)
'属性を取得
Debug.Print "testname:" & cls.getAttributeValueEx("testname") & " testname2:" & cls.getAttributeValueEx("testname2")
Loop
Set cls = Nothing
MsgBox "おわり"
End Sub
''結果''
testname:testvalue testname2:10
#hr
***test4(子ノードの取得)
Sub xml_test4_3()
Dim cls As New XMLUtilClass
'XMLファイルをロード
cls.loadXML ("C:\temp\test.xml")
'XPathからセレクションノードを取得
cls.getSelectionNode ("testelement1")
Do While (Not cls.getNextNode() Is Nothing)
Dim childNodelist As IXMLDOMNodeList
Dim childNode As IXMLDOMNode
'子ノードリストを取得
Set childNodelist = cls.getChildNodes
'子ノードを全て取得
For Each childNode In childNodelist
'属性を取得
Debug.Print " testname1:" & cls.getAttributeValue(childNode, "testname") & _
" testname2:" & cls.getAttributeValue(childNode, "testname2") & _
" NodeValue:" & cls.getNodeValue(childNode)
Next
Set childNodelist = Nothing
Set childNode = Nothing
Loop
Set cls = Nothing
MsgBox "おわり"
End Sub
''結果''
testname1:testvaluetestname2:5 nodevalue1
testname1:testvaluetestname2:10 nodevalue2
#hr
#comment()
2008-06-24T18:34:40+09:001214300080VBA/XML/簡単なVBAでXMLサンプル
https://w.atwiki.jp/enusii/pages/18.html
**XMLファイルを読み込む
xmlファイルを読み込むにはDOMDocumentのloadを使用します。
Dim g_XMLDocument AS New DOMDocument50
g_XMLDocument.async = False
g_XMLDocument.load ("C:\test.xml")
If g_XMLDocument.parsed = False Then
MsgBox "ファイル形式がXMLでありません。"
End If
**XMLファイルを新規作成する
Dim g_XMLDocument As New DOMDocument50
Dim s As String
s = "<?xml version=""1.0"" encoding=""UTF-8""?>"
g_XMLDocument.loadXML s
#comment()
2008-06-24T18:34:24+09:001214300064JAVA/ダイアログを表示する
https://w.atwiki.jp/enusii/pages/14.html
//タイトル
String title = "test_title";
//save用にダイアログを作成
FileDialog fd = new FileDialog(new Dialog(new Frame()), title, FileDialog.SAVE);
//ディレクトリを指定
fd.setDirectory("C:\\temp");
//ファイル名を指定
fd.setFile("test.text");
//ダイアログを表示
fd.setVisible(true);
//取得内容確認
System.out.println("取得パス = " + fd.getDirectory());
System.out.println("取得ファイル名 = " + fd.getFile());
#comment()
2008-06-24T18:33:58+09:001214300038