Indexへ
(15505)//【15503】→(15504)
------------------------
【タイトル】JWWの測定機能で測定した結果について
【記事番号】 15503 (*)
【 日時 】09/07/10 22:41
【 発言者 】老眼鏡

JWWの測定機能で測定した面積　長の結果を　簡単にエクセルのシートに書き込む方法、もしくわソフトがあったら教えてください


Indexへ
(15503)←【15504】→(15511)
------------------------
【タイトル】Re(1):JWWの測定機能で測定した結果について
【記事番号】 15504 (15503)
【 日時 】09/07/10 23:10
【 発言者 】kubo

▼老眼鏡さん：
>JWWの測定機能で測定した面積　長の結果を　簡単にエクセルのシートに書き込む方法、もしくわソフトがあったら教えてください


測定結果をJw_cadの画面に「測定結果書込」して、それを「コピー」
して、エクセルのセルに「貼付」すればよいです。複数データも
（複数セル＝縦方向に）貼り付けられます。


Indexへ
(15504)←【15511】//(15508)
------------------------
【タイトル】Re(1):JWWの測定機能で測定した結果について
【記事番号】 15511 (15503)
【 日時 】09/07/12 02:30
【 発言者 】いっち

▼老眼鏡さん：
>JWWの測定機能で測定した面積　長の結果を　簡単にエクセルのシートに書き込む方法、
>もしくわソフトがあったら教えてください

ちょっと、考えてみました。

基本的に、kuboさんが言われるように、
>測定結果をJw_cadの画面に「測定結果書込」して
から、実行させるものです。

何部屋かまとめて測定してから、実行させても良いでしょうし、
ひと部屋測定する毎に、実行させてもよいかと思います。

基本的に、Excelへ転記.xlsのSheet1に対して、追記していくものです。
ご希望に合うものかどうかは、わかりません。

Excelへ転記.bat、Excelへ転記.vbs、Excelへ転記.xlsを
全て同じフォルダーに入れて実行させてください。

--- Excelへ転記.bat --- ↓この下から

@REM Excelへ転記
@echo off
REM #jww
REM #cd
REM #hm |間口奥行含|室名と面積|
REM #:1
REM #bz
REM #1ch 室名をクリックしてください。
REM #2ch 面積(A)をクリックしてください。
REM #3ch 間口(x)をクリックしてください。
REM #4ch 奥行(y)をクリックしてください。
REM #hr
REM #e
REM #:2
REM #bz
REM #1ch 室名をクリックしてください。
REM #2ch 面積(A)をクリックしてください。
REM #hr
REM #e
copy jwc_temp.txt temp.txt > nul
del jwc_temp.txt
WScript.exe Excelへ転記.vbs
exit
[注意事項]
1.エクセルに転記する、室名、面積、間口、奥行などは
　予め、図面上に記載しておいてください。

----------------------- ↑この上まで

--- Excelへ転記.vbs --- ↓この下から

Option Explicit

Private myBookName, myBook
Private objApp, blnFlg
Do
　　　　myBookName = "Excelへ転記.xls"
　　　　blnFlg = False
　　　　With WScript
　　　　　　　　myBook = Replace(.ScriptFullName, .ScriptName, myBookName)
　　　　End With
　　　　On Error Resume Next
　　　　Set objApp = GetObject(, "Excel.Application")
　　　　On Error Goto 0
　　　　If IsEmpty(objApp) Then
　　　　　　　　With GetObject("", "EXcel.Application")
　　　　　　　　　　　　.Visible = True
　　　　　　　　　　　　.Workbooks.Open(myBook)
　　　　　　　　End With
　　　　Else
　　　　　　　　Set objApp = Nothing
　　　　End If
　　　　With CreateObject("WScript.Shell")
　　　　　　　　blnFlg = .AppActivate(myBookName)
　　　　End With
　　　　WScript.Sleep 100
　　　　If Not blnFlg Then
　　　　　　　　MsgBox myBookName & "が開かれていません。", vbExclamation, _
　　　　　　　　　　　　 "Excelへ転記"
　　　　　　　　Exit Do
　　　　End If
　　　　With GetObject(myBook)
　　　　　　　　.Application.Run "'" & myBook & "'!Start"
　　　　End With
Loop Until True

----------------------- ↑この上まで

--- Excelへ転記.xls --- ↓この下から

Option Explicit

'エクセルにて、Alt + F11キーにて、Visual Basic Editorを表示させる。
'Visual Basic Editorにて、挿入〜標準モジュールを実行し、
'表示された標準モジュールに、下記マクロを記入する。

'この外変を実行させる前に、予めこのブックを開いておくか、
'あるいはこの外変を実行させる前に、エクセルを終了させて
'おくかいずれかにしてください。

Sub Start()
　　Dim myFile As String, ss As String, strtemp() As String
　　Dim myFlg As Boolean
　　Dim myCount As Long, i As Long, LastRow As Long
　　Dim myTitle As Variant, v As Variant
　　
　　myTitle = Array("室名", "面積[A]", "間口[x]", "奥行[y]")
　　myFile = ThisWorkbook.Path & Application.PathSeparator & "temp.txt"
　　Open myFile For Input As #1
　　Do Until EOF(1)
　　　　Line Input #1, ss
　　　　If myFlg Then
　　　　　　Select Case True
　　　　　　　　Case ss Like "c[hvs]*"
　　　　　　　　　　myCount = myCount + 1
　　　　　　　　　　strtemp = Split(ss, " ", 6)
　　　　　　　　　　v(myCount) = Mid$(strtemp(5), 2)
　　　　　　End Select
　　　　Else
　　　　　　Select Case True
　　　　　　　　Case ss Like "hp[0-9]*"
　　　　　　　　　　myCount = myCount + 1
　　　　　　　　Case ss = "bz"
　　　　　　　　　　ReDim v(1 To myCount)
　　　　　　　　　　myFlg = True
　　　　　　　　　　myCount = 0
　　　　　　End Select
　　　　End If
　　Loop
　　Close #1
　　If myCount = 0 Then Exit Sub
　　With Sheet1
　　　　With .Range("A1")
　　　　　　For i = 1 To 4
　　　　　　　　If IsEmpty(.Item(1, i).Value) Then .Item(1, i).Value = _
　　　　　　　　　　myTitle(i - 1)
　　　　　　Next
　　　　　　LastRow = .CurrentRegion.Rows.Count
　　　　End With
　　　　With .Range("A" & LastRow + 1).Resize(, UBound(v))
　　　　　　.Value = v
　　　　End With
　　End With
End Sub

----------------------- ↑この上まで