投稿者「xvax」のアーカイブ

IE:frame処理

投稿日時: 投稿者:

参照設定にて下記の２つを有効にする
MS Internet Controls :IEのため
MS HTML Object Library :フレーム処理

該当のURLを開いて、左フレーム内のURLをクリック
上フレームのTEXTBOXに値をセットしてSUBMIT
右フレームに出てきた値(結果)を取り出す

Private Sub html_go()
	Dim IE As InternetExplorer
	Dim objFRAME As FramesCollection
	Dim objDOC As HTMLDocument

	Set IE = CreateObject("internetExplorer.application")

	IE.Navigate "http://~~~/"
	IE.Visible = True
	Do While IE.Busy = True: DoEvents: Loop

	Set objFRAME = IE.Document.frames
	'NAME=lview　のフレーム内処理
	Set objDOC = objFRAME("F_left").Document
	objDOC.all.Item(23).Click 'HWInfo click
	Do While IE.Busy = True: DoEvents: Loop

	Set objFRAME = IE.Document.frames
	'NAME=tview　のフレーム内処理
	Set objDOC = objFRAME("F_top").Document

	objDOC.all("text box").Value = "値"
	objDOC.forms(0).submit
	Do While IE.Busy = True: DoEvents: Loop

	'NAME=rview　のフレーム内処理
	Set objDOC = objFRAME("F_right").Document
	strHTML = objDOC.all(0).innerText

	Debug.Print strHTML
	Set IE = Nothing
	MsgBox "done!"
End Sub

ODBC linkリフレッシュ

投稿日時: 投稿者: 
Private Sub btnGO_Click()
	
	Dim wkTBL As String, wkLEN As String, wkDSN As String
	Dim WKSRCTBL As String, wkUID
	Dim MyTbl As DAO.TableDef
	Dim prp As DAO.Property
	
	For Each MyTbl In CurrentDb.TableDefs
		wkTBL = MyTbl.Name
		WKSRCTBL = MyTbl.SourceTableName
		If MyTbl.Attributes And dbAttachedODBC Then
			wkLEN = InStr(1, MyTbl.Connect, “DSN=") + 4
			wkDSN = Mid(MyTbl.Connect, wkLEN, InStr(wkLEN, MyTbl.Connect, “;") – wkLEN)
			'call link
			AUTO_LINK wkTBL, WKSRCTBL, wkDSN, “userid", “password"
			End If
		End If
	Next
	
	MsgBox “done!"
	Exit Sub
End Sub

Sub AUTO_LINK(dbtable As String, dbname As String, dsn As String, uid As String, pwd As String)
	
	Dim db As Database, TblDef As TableDef
	Dim prp As DAO.Property, flgpw As Boolean
	
	flgpw = True 'save password in link
	On Error Resume Next
	'delete
	DoCmd.DeleteObject acTable, dbtable
	On Error GoTo 0
	Set db = DBEngine.Workspaces(0).Databases(0)
	
	Set TblDef = db.CreateTableDef(dbtable)
	TblDef.Connect = “ODBC;DSN=" & dsn & “;UID=" & uid & “;PWD=" & pwd
	TblDef.SourceTableName = dbname
	If flgpw Then
		TblDef.Attributes = dbAttachSavePWD
	End If
	
	db.TableDefs.Append TblDef
	
	Set prp = TblDef.CreateProperty(“Description", dbText, dsn & “:" & uid)
	TblDef.Properties.Append prp
	TblDef.Properties.Refresh
	TblDef.RefreshLink
End Sub

クエリ内容をテキストSQLよりインポート

投稿日時: 投稿者: 
Private Sub btnGO_Click()
	
	Dim wkTBL As String, wkLEN As String, wkDSN As String
	Dim WKSRCTBL As String, wkUID
	Dim MyTbl As DAO.TableDef
	Dim prp As DAO.Property
	
	For Each MyTbl In CurrentDb.TableDefs
		wkTBL = MyTbl.Name
		WKSRCTBL = MyTbl.SourceTableName
		If MyTbl.Attributes And dbAttachedODBC Then
			wkLEN = InStr(1, MyTbl.Connect, “DSN=") + 4
			wkDSN = Mid(MyTbl.Connect, wkLEN, InStr(wkLEN, MyTbl.Connect, “;") – wkLEN)
			'call link
			AUTO_LINK wkTBL, WKSRCTBL, wkDSN, “userid", “password"
			End If
		End If
	Next
	
	MsgBox “done!"
	Exit Sub
End Sub

Sub AUTO_LINK(dbtable As String, dbname As String, dsn As String, uid As String, pwd As String)
	
	Dim db As Database, TblDef As TableDef
	Dim prp As DAO.Property, flgpw As Boolean
	
	flgpw = True 'save password in link
	On Error Resume Next
	'delete
	DoCmd.DeleteObject acTable, dbtable
	On Error GoTo 0
	Set db = DBEngine.Workspaces(0).Databases(0)
	
	Set TblDef = db.CreateTableDef(dbtable)
	TblDef.Connect = “ODBC;DSN=" & dsn & “;UID=" & uid & “;PWD=" & pwd
	TblDef.SourceTableName = dbname
	If flgpw Then
		TblDef.Attributes = dbAttachSavePWD
	End If
	
	db.TableDefs.Append TblDef
	
	Set prp = TblDef.CreateProperty(“Description", dbText, dsn & “:" & uid)
	TblDef.Properties.Append prp
	TblDef.Properties.Refresh
	TblDef.RefreshLink
End Sub

クエリ名とSQLをテキスト出力

投稿日時: 投稿者: 
Sub クエリをテキスト出力する()
	Dim dbs As Database
	Dim intCount As Integer
	Dim QDF As QueryDef
	
	Open “c:\temp\export_query.txt" For Output As #1
	Set dbs = CurrentDb
	
	For intCount = 0 To dbs.QueryDefs.Count – 1
		Set QDF = dbs.QueryDefs(intCount)
		Print #1, QDF.Name
		Print #1, QDF.SQL
		'Debug.Print QDF.SQL
	Next
	
	Close
End Sub

Export name of Query

投稿日時: 投稿者: 
Sub Sample()
	Dim mymydb  As Database
	
	Set mydb = CurrentDb
	
	Debug.Print "すべてのクエリ名を出力します"
	For Each myqer In mydb.QueryDefs
		Debug.Print myqer.Name
	Next
End Sub

XAMPP Debugger

投稿日時: 投稿者:

下記をphp.iniに追加。

[Zend]
zend_extension_manager.debug_server_ts = “C:\xampp\php\zendOptimizer\lib\Debugger”
zend_debugger.deny_hosts = all
zend_debugger.allow_hosts = 127.0.0.1
zend_debugger.expose_remotely = always

php_debugger

Excel表をXML出力

投稿日時: 投稿者: 
Sub make_xml()
	Dim xdoc As New DOMDocument, xtree As IXMLDOMElement
	Dim PI As IXMLDOMProcessingInstruction
	Dim LOB As IXMLDOMElement
	Dim fld As IXMLDOMElement
	'xml header
	Set PI = xdoc.createProcessingInstruction(“xml", “version=’1.0′ encoding=’UTF-8′ standalone=’yes’")
	Call xdoc.appendChild(PI)
	'root tree
	Set xtree = xdoc.createElement(“all")
	xtree.Text = vbNewLine
	Call xdoc.appendChild(xtree)
	'横軸チェック
	x = 1
	Do While Cells(1, x) <> “": x = x + 1: Loop
	x = x – 1

	y = 2
	'縦ループ
	Do While Cells(y, 1) <> “"
		'親
		Set LOB = xdoc.createElement(“data")
		'横ループ
		For i = 1 To x
			'子1
			Set fld = xdoc.createElement(Cells(1, i))
			fld.Text = Cells(y, i)
			Call LOB.appendChild(fld)
			Call LOB.appendChild(xdoc.createTextNode(vbNewLine))
		Next
		'親書き出し
		Call xtree.appendChild(LOB)
		y = y + 1
	Loop
	'xml保存
	xdoc.Save (“c:\temp\swlist.xml")
	MsgBox “done"
End Sub

ピボット内の上位フィルター＆並び替え

投稿日時: 投稿者: 
Sub run()
	'引数：並べ替えのフィールド名、対象のシート名、Pivot実データの開始Y番号,TOP幾つまでを表示するか
	pivot_SORT_TOP "TITLE”, "Sheet4″, 5, 10
End Sub

'X軸は日付など、並び替え可能な項目であること
Sub pivot_SORT_TOP(CMname As String, pivot_sheet As String, Y As Long, TOP As Integer)

	Dim X As Long, CH As String

	Sheets(pivot_sheet).Select

	On Error Resume Next
	'縦の項目を一度、全部表示にする
	For i = 1 To ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count
		ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems(i).Visible = True
	Next
	
	'Pivotの末列の座標を探す
	X = 2
	Do While Cells(Y – 1, X) <> "”: X = X + 1: Loop
	X = X – 1
	
	'横列の昇順並び替え
	Cells(Y – 1, 2).Select
	Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=1, _
		Orientation:=xlLeftToRight, SortMethod:=xlPinYin
	
	'並び替えたい列を選択
	Cells(Y, X).Select
	'Range(Chr(64 + X) & Y).Select
	
	'X,Y座標をR1C1形式に変換
	CH = "R” & Y & "C” & X
	'末列を降順でSORT
	Selection.Sort Key1:=CH, Order1:=xlDescending, Type:=xlSortValues, _
		OrderCustom:=1, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
	
	'表示項目がTOP指定より多い場合は、フィルター処理
	If ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count > TOP Then
	
		On Error Resume Next
		'TOP以降は非表示する
		For i = TOP + 1 To ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems.Count
			ActiveSheet.PivotTables(1).PivotFields(CMname).PivotItems(i).Visible = False
		Next
	End If
	On Error GoTo 0
	
End Sub