Option Explicit
Sub MailAutoSend()
Dim ws As Worksheet
Dim outlookObj As Outlook.Application
Dim mymail As Outlook.MailItem
Dim mailbody As String
Dim credit As String
Set ws = Worksheets("Sheet1")
Set outlookObj = CreateObject("Outlook.Application")
Set mymail = outlookObj.CreateItem(olMailItem)
mymail.BodyFormat = 3 'リッチテキストに変更
mymail.To = ws.Range("B2").Value 'To宛先
mymail.CC = ws.Range("B3").Value
mymail.BCC = ws.Range("B4").Value
mymail.Subject = ws.Range("B5").Value '件名
mailbody = ws.Range("B6").Value '本文
credit = ws.Range("B7").Value '署名
mymail.Body = mailbody & vbCrLf & vbCrLf & credit
'メール表示
mymail.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない)
'メール保存
mymail.Save '下書き保存
'メール送信
mymail.Send
'オブジェクト解放
Set outlookObj = Nothing
Set mymail = Nothing
End Sub
補正
'補正値取得・補正コード生成
For pulse_sel = MEAS_START To MEAS_PHASE_COUNT Step 1
For freq_num = FREQ_START To FREQ_START + FREQ_COUNT Step 1
For sosi_num = SOSI_START To SOSI_START + SOSI_COUNT Step 1
If pulse_num = 0 Then
DAT(freq_num, sosi_num, pulse_sel).hosei_deg = PassPulse(freq_num, sosi_num, PHASE_START, pulse_sel).PHS
End If
Next
deg = DAT(freq_num, sosi_num, pulse_sel).hosei_deg
'ここに補正コード生成を入れる
Next
Next
リニアリティ算出
risou_gosa_total = 0.0
For pulse_sel = MEAS_START To MEAS_PHASE_COUNT Step 1
For freq_num = FREQ_START To FREQ_START + FREQ_COUNT Step 1
For sosi_num = SOSI_START To SOSI_START + SOSI_COUNT Step 1
For pulse_num = PHASE_START To PHASE_START + PHASE_COUNT Step 1
'直線化
If PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).PHS < 0 Then
PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).Linearise = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).PHS + 360
Else
PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).Linearise = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).PHS
End If
'位相[00]を0に正規化するため数値
If pulse_num = 0 Then
zero_base = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).Linearise
End If
'正規化
PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).normalize = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).Linearise - zero_base
'理想直線との誤差
PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).risou_gosa = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).normalize - risou_phs(pulse_num)
'トータル(平均値算出のため)
risou_gosa_total = risou_gosa_total + PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).risou_gosa
Next
'平均値算出
DAT(freq_num, sosi_num, pulse_sel).risou_gosa_ave = risou_gosa_total / (PHASE_START + PHASE_COUNT + 1)
Next
Next
Next
Hensa_total = 0.0
'位相リニアリティ算出(Stdev関数の代用)
For pulse_sel = MEAS_START To MEAS_PHASE_COUNT Step 1
For freq_num = FREQ_START To FREQ_START + FREQ_COUNT Step 1
For sosi_num = SOSI_START To SOSI_START + SOSI_COUNT Step 1
For pulse_num = PHASE_START To PHASE_START + PHASE_COUNT Step 1
'偏差
DAT(freq_num, sosi_num, pulse_sel).Hensa = PassPulse(freq_num, sosi_num, pulse_num, pulse_sel).risou_gosa - DAT(freq_num, sosi_num, pulse_sel).risou_gosa_ave
Hensa_total = Hensa_total + (DAT(freq_num, sosi_num, pulse_sel).Hensa ^ 2)
Next
'分散
DAT(freq_num, sosi_num, pulse_sel).Bunsan = Hensa_total / (PHASE_START + PHASE_COUNT + 1)
'リニアリティ算出(標準偏差)
DAT(freq_num, sosi_num, pulse_sel).Linearity = Math.Sqrt(DAT(freq_num, sosi_num, pulse_sel).Bunsan)
Next
Next
Next
確認事項
確認事項
・補正無し 0x1000 1:無し 0:有り
変更点
・autotest_setting()野中
素子のコマンドFTE.CMD_SET(&H100D,**)を削除し、
通過位相の素子ループ直後に
FTE.CMD_SET(&H100D,(SOSI_NUM << 16))
を追加する。
・通過位相は
ATTユニット設定(att_unit_control)、1素子ON(TXE_Change)
を使わないらしい…
・測定完了待ちの時
測定停止ボタン押した時の処理内にNA.VISA_CLEAR()を追加
マクロ
Sub 右矢印検索_次行に表示()
Dim start_row(100) As Integer
Dim start_col(100) As Integer
Dim end_row(100) As Integer
Dim end_col(100) As Integer
Dim Shp As Shape
Dim Ran As Range
Dim RowCell, point As Integer
Dim strRow, strCol, endRow, endCol As Integer
Dim shpwidth As Integer
point = 0
'********************************************************
'矢印検索
'********************************************************
For RowCell = 1 To Range("A65536").End(xlUp).Row
Rows(RowCell).Select
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoAutoShape Then
shpwidth = Shp.Width
Set Ran = Range(Shp.TopLeftCell, Shp.BottomRightCell)
If Intersect(Ran, Selection) Is Nothing = False Then
point = point + 1
If InStr(Ran.address(False, False), ":") > 0 Then '複数セルがある場合
start_row(point) = Range(Left(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Row
start_col(point) = Range(Left(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Column
end_row(point) = Range(Right(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Row
end_col(point) = Range(Right(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Column
Else
start_row(point) = Range(Ran.address(False, False)).Row
start_col(point) = Range(Ran.address(False, False)).Column
end_row(point) = start_row(point)
end_col(point) = start_col(point)
End If
End If
End If
Next
Next
'********************************************************
'次行に矢印
'********************************************************
For RowCell = 1 To point
strRow = start_row(point)
strCol = start_col(point)
endRow = end_row(point)
endCol = end_col(point)
'Call 右矢印表示_NextRow(strRow, strCol, endRow, endCol)
Call 右矢印表示_NextRow(start_row(point), start_col(point), end_row(point), end_col(point), shpwidth)
Next
End Sub
Sub 右矢印表示_NextRow(strRow As Integer, strCol As Integer, endRow As Integer, endCol As Integer, shpwidth As Integer)
Dim Ran As Range
Set Ran = Range(Cells(strRow, strCol), Cells(endRow, endCol))
' With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Ran.Left, Ran.Top + Ran.Height / 2, Ran.Left + Ran.Width, Ran.Top + Ran.Height / 2).Line
With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Ran.Left, Ran.Top + Ran.Height / 2, Ran.Left + shpwidth, Ran.Top + Ran.Height / 2).Line
.ForeColor.RGB = vbBlack
.EndArrowheadStyle = 2
.Weight = 2
End With
End Sub