computer/programing/vba
の編集
http://siti.dip.jp/wiki/index.php?computer/programing/vba
[
トップ
] [
編集
|
差分
|
バックアップ
|
添付
|
リロード
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
|
ログイン
]
-- 雛形とするページ --
bikefriday
books
BracketName
chemical
computer
computer/equation
computer/gromacs
computer/linux
computer/linux/apache2
computer/linux/cluster
computer/linux/emacs
computer/linux/FreeNAS
computer/linux/iptables
computer/linux/networking
computer/linux/ProFTPD
computer/linux/pukiwiki
computer/linux/RaspberryPi
computer/linux/service
computer/linux/torque
computer/programing
computer/programing/Eclipse
computer/programing/Python
computer/programing/python
computer/programing/Python/matplotlib
computer/programing/regular expression
computer/programing/vba
computer/programing/vmd
computer/windows
computer/windows/command prompt
computer/windows/ffmpeg
computer/windows/ImageJ
computer/windows/Inkscape
computer/windows/service
computer/windows/VBA
computer/windows/WebExpression
english
english/mail
english/P.R. response
english/あ
english/か
english/さ
FormattingRules
FrontPage
gnuplot
Help
InterWiki
InterWikiName
InterWikiSandBox
memo
memo/201902
memo/201903
memo/201904
memo/201905
memo/201907
memo/201911
memo/ai
memo/descri
memo/document
memo/life
memo/message
memo/procedure
memo/record
memo/work
memo/引っ越し
MenuBar
microserver
Notebook
PHP
PukiWiki
PukiWiki/1.4
PukiWiki/1.4/Manual
PukiWiki/1.4/Manual/Plugin
PukiWiki/1.4/Manual/Plugin/A-D
PukiWiki/1.4/Manual/Plugin/E-G
PukiWiki/1.4/Manual/Plugin/H-K
PukiWiki/1.4/Manual/Plugin/L-N
PukiWiki/1.4/Manual/Plugin/O-R
PukiWiki/1.4/Manual/Plugin/S-U
PukiWiki/1.4/Manual/Plugin/V-Z
RecentDeleted
SandBox
ST
testable
WikiEngines
WikiName
WikiWikiWeb
work
YukiWiki
#contents #highlighter(VBScript){{ Sub DelAllGraph() ActiveSheet.ChartObjects.Delete End Sub }} #highlighter(VBScript){{ Sub data_reduction001() 'This proguram takes order the original experimental data. 'The original data is "粘度2016.xlsm" which is located in RAID02. l = 1 For i = 1 To 7 For j = 1 To 4 For k = 1 To 11 Cells(20 * l + k - 1, 7) = Cells(1 + j, -4 + 11 * i + k) Next k l = l + 1 Next j Next i End Sub }} #highlighter(VBScript){{ Sub Narae_Previous000() 'Upper cell is refered by using this program. 'This program is used to handle different experimental data number. Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim n As Double n = 1 i = 1 Do While Cells(20 * i + 1, 3) <> "" k = 0 n = 1 For j = 1 To 20 If Cells(20 * i + j, 3) <> n Then Range(Cells(20 * i + j, 1), Cells(20 * i + j, 30)).Font.Color = vbRed k = k + 1 Else Range(Cells(20 * i + j, 1), Cells(20 * i + j, 30)).Font.Color = vbBlack Cells(20 * i + j, 4) = "=d" & 20 * i + j - 1 Cells(20 * i + j, 5) = "=e" & 20 * i + j - 1 End If n = Cells(20 * i + j, 3) Next j i = i + 1 Loop End Sub }} #highlighter(VBScript){{ Sub Calc_ExcessMolarVolume() Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim n As Double n = 1 i = 1 Do While Cells(20 * i + 1, 3) <> "" k = 0 n = 1 For j = 1 To 20 Cells(20 * i + j, 10) = "=i" & 20 * i + j & "-(i" & 20 * i + 1 & "*(1-" & "c" & 20 * i + j & ")+c" & 20 * i + j & "*i" & 20 * i + 20 & ")" Next j i = i + 1 Loop End Sub }} *キーワードを蛍光ペンで着色(word用) [#pd75bcfb] #highlighter(VBScript,number=off){{ Sub キーワードを蛍光ペンで着色() Dim myRange As Range Dim myKW As String Dim myColor As String myKW = InputBox("キーワードを入力してください。") 'キーワードが入力されない場合には終了 If myKW = "" Then Exit Sub '現在の蛍光ペンの色を保存 myColor = Options.DefaultHighlightColorIndex '蛍光ペンの色を黄色に設定 Options.DefaultHighlightColorIndex = wdYellow 'wdAuto 'wdBlack 'wdBlue 'wdBrightGreen 'wdByAuthor 'wdDarkBlue 'wdDarkRed 'wdDarkYellow 'wdGray25 'wdGray50 'wdGreen 'wdNoHighlight 'wdPink 'wdRed 'wdTeal 'wdTurquoise 'wdViolet 'wdWhite 'wdYellow 'myRange(オブジェクト変数)を設定 Set myRange = ActiveDocument.Range(0, 0) '一括置換を実行(「検索と置換」ダイアログボックスの設定) With myRange.Find .Text = myKW '検索する文字列 .Replacement.Text = "" '置換後の文字列(空欄でOK) .Replacement.Highlight = True '置換後の文字列の蛍光ペンをオン .Forward = True .Wrap = wdFindStop .Format = True '書式の設定をオン .MatchCase = False '大文字と小文字の区別する .MatchWholeWord = False '完全に一致する単語だけを検索する .MatchByte = False '半角と全角を区別する .MatchAllWordForms = False '英単語の異なる活用形を検索する .MatchSoundsLike = False 'あいまい検索(英) .MatchFuzzy = False 'あいまい検索(日) .MatchWildcards = False 'ワイルドカードを使用する .Execute Replace:=wdReplaceAll End With '蛍光ペンの色を元に戻す Options.DefaultHighlightColorIndex = myColor 'myRangeを解放 Set myRange = Nothing End Sub }} *グラフ作図(密度データ) [#r67ef280] #highlighter(VBScript){{ Sub Draw_Graph000() 'This program draw the graphs of volumetric and viscometric behaviors. Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim n As Integer Dim gpos_x As Integer Dim gpos_y As Integer Dim g_width As Integer Dim g_hight As Integer Dim chartObj As ChartObject Dim ans As Integer Dim graph_name As String Dim data_number(20) As Integer Dim alcohol As String Dim strSheetName As String strSheetName = ActiveSheet.Name ' アクティブシート上に既存のグラフがあれば削除 If ActiveSheet.ChartObjects.Count > 0 Then For i = 1 To ActiveSheet.ChartObjects.Count ' グラフ名が一致するか If ActiveSheet.ChartObjects(i).Name = graph_name Then ActiveSheet.ChartObjects(i).Delete Exit For End If Next i End If alcohol = strSheetName physical_value = "density" If alcohol = "methanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "ethanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "1-propanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "2-propanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K End If For i = 1 To n 'グラフの位置 gpos_x = 420 * (1 - 1) + 100 gpos_y = 299 * (i - 1) + 300 'グラフのサイズ g_width = 90 * 4 g_hight = 90 * 3 ' グラフ識別子 graph_name = "numbered_entry" 'Objects追加位置(左位置, 上位置, 幅, 高さ) Set chartObj = ActiveSheet.ChartObjects.Add(gpos_x, gpos_y, g_width, g_hight) chartObj.Name = graph_name 'ChartArea設定 chartObj.Chart.ChartArea.Format.Line.Visible = msoFalse With chartObj.Chart 'ChartArea設定 .ChartArea.Format.Line.Visible = msoFalse .PlotArea.Select 'PlotArea設定(暫定) With Selection .Format.Line.ForeColor.ObjectThemeColor = msoThemeColorText1 'plot area枠を黒に .Height = 230 .Width = 320 .Top = 5 .Left = 25 End With For j = 1 To data_number(i) 'データ設定 If j <> 1 Then .SeriesCollection.NewSeries End If With .SeriesCollection(j) l = 20 For k = 1 To i - 1 l = l + data_number(k) * 20 Next k l = l + 20 * (j - 1) .Values = Range(Cells(l + 1, 4), Cells(l + 20, 4)) .XValues = Range(Cells(l + 1, 3), Cells(l + 20, 3)) .Name = Cells(l + 1, 13) .ChartType = xlXYScatterLines '以下散布図線付き時のみ With .Format.Line '線を作画するか .Visible = msoTrue '線の太さ .Weight = 0.5 '点線 '.DashStyle = msoLineSysDash .ForeColor.RGB = RGB(127 * (Int(j / 9) Mod 3), 127 * (Int(j / 3) Mod 3), 127 * (Int(j) Mod 3)) End With '.ChartType = xlXYScatter '散布図 .MarkerStyle = xlMarkerStyleCircle 'マーカー (丸) .MarkerSize = 5 .MarkerBackgroundColorIndex = 0 'マーカー塗りつぶしの色 .MarkerForegroundColor = RGB(127 * (Int(j / 9) Mod 3), 127 * (Int(j / 3) Mod 3), 127 * (Int(j) Mod 3)) End With Next j 'グラフタイトル .HasTitle = True With .ChartTitle .Text = alcohol .Left = 60 .Top = 15 With .Format.TextFrame2.TextRange.Font .Bold = msoFalse .Size = 10 'MS P ゴシック .Name = "+mj-ea" End With End With 'x軸タイトル With .Axes(xlCategory, xlPrimary) .HasTitle = True With .AxisTitle .Font.Bold = msoFalse If alcohol = "methanol" Then .Characters.Text = "xm" 'ここでの(1, 1)は文字の範囲を指定 .Characters(1, 1).Font.FontStyle = "italic" '下付き .Characters(2, 1).Font.Subscript = True ElseIf alcohol = "ethanol" Then .Characters.Text = "xe" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 1).Font.Subscript = True ElseIf alcohol = "1-propanol" Then .Characters.Text = "x1pro" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 5).Font.Subscript = True ElseIf alcohol = "2-propanol" Then .Characters.Text = "x2pro" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 5).Font.Subscript = True Else .Characters.Text = "x" .Characters(1, 1).Font.FontStyle = "italic" End If .Characters.Font.Size = 12 End With End With 'y軸タイトル With .Axes(xlValue, xlPrimary) .HasTitle = True With .AxisTitle .Font.Bold = msoFalse .Characters.Text = "density / kg m-3" .Characters(15, 2).Font.Superscript = True End With End With 'x軸設定 With .Axes(xlCategory) .MaximumScale = 1 .MinimumScale = 0 .MajorTickMark = xlInside '軸目盛内向き .TickLabels.NumberFormatLocal = "G/標準" .MajorGridlines.Delete '補助線を削除 With .Format.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 End With End With 'y軸設定 With .Axes(xlValue) .MajorTickMark = xlInside .TickLabels.NumberFormatLocal = "G/標準" .MajorGridlines.Delete With .Format.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 End With End With '凡例設定 With .Legend .Left = 230 .Width = 100 .Height = 100 .Top = 100 End With End With Next i End Sub }}
タイムスタンプを変更しない
#contents #highlighter(VBScript){{ Sub DelAllGraph() ActiveSheet.ChartObjects.Delete End Sub }} #highlighter(VBScript){{ Sub data_reduction001() 'This proguram takes order the original experimental data. 'The original data is "粘度2016.xlsm" which is located in RAID02. l = 1 For i = 1 To 7 For j = 1 To 4 For k = 1 To 11 Cells(20 * l + k - 1, 7) = Cells(1 + j, -4 + 11 * i + k) Next k l = l + 1 Next j Next i End Sub }} #highlighter(VBScript){{ Sub Narae_Previous000() 'Upper cell is refered by using this program. 'This program is used to handle different experimental data number. Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim n As Double n = 1 i = 1 Do While Cells(20 * i + 1, 3) <> "" k = 0 n = 1 For j = 1 To 20 If Cells(20 * i + j, 3) <> n Then Range(Cells(20 * i + j, 1), Cells(20 * i + j, 30)).Font.Color = vbRed k = k + 1 Else Range(Cells(20 * i + j, 1), Cells(20 * i + j, 30)).Font.Color = vbBlack Cells(20 * i + j, 4) = "=d" & 20 * i + j - 1 Cells(20 * i + j, 5) = "=e" & 20 * i + j - 1 End If n = Cells(20 * i + j, 3) Next j i = i + 1 Loop End Sub }} #highlighter(VBScript){{ Sub Calc_ExcessMolarVolume() Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim n As Double n = 1 i = 1 Do While Cells(20 * i + 1, 3) <> "" k = 0 n = 1 For j = 1 To 20 Cells(20 * i + j, 10) = "=i" & 20 * i + j & "-(i" & 20 * i + 1 & "*(1-" & "c" & 20 * i + j & ")+c" & 20 * i + j & "*i" & 20 * i + 20 & ")" Next j i = i + 1 Loop End Sub }} *キーワードを蛍光ペンで着色(word用) [#pd75bcfb] #highlighter(VBScript,number=off){{ Sub キーワードを蛍光ペンで着色() Dim myRange As Range Dim myKW As String Dim myColor As String myKW = InputBox("キーワードを入力してください。") 'キーワードが入力されない場合には終了 If myKW = "" Then Exit Sub '現在の蛍光ペンの色を保存 myColor = Options.DefaultHighlightColorIndex '蛍光ペンの色を黄色に設定 Options.DefaultHighlightColorIndex = wdYellow 'wdAuto 'wdBlack 'wdBlue 'wdBrightGreen 'wdByAuthor 'wdDarkBlue 'wdDarkRed 'wdDarkYellow 'wdGray25 'wdGray50 'wdGreen 'wdNoHighlight 'wdPink 'wdRed 'wdTeal 'wdTurquoise 'wdViolet 'wdWhite 'wdYellow 'myRange(オブジェクト変数)を設定 Set myRange = ActiveDocument.Range(0, 0) '一括置換を実行(「検索と置換」ダイアログボックスの設定) With myRange.Find .Text = myKW '検索する文字列 .Replacement.Text = "" '置換後の文字列(空欄でOK) .Replacement.Highlight = True '置換後の文字列の蛍光ペンをオン .Forward = True .Wrap = wdFindStop .Format = True '書式の設定をオン .MatchCase = False '大文字と小文字の区別する .MatchWholeWord = False '完全に一致する単語だけを検索する .MatchByte = False '半角と全角を区別する .MatchAllWordForms = False '英単語の異なる活用形を検索する .MatchSoundsLike = False 'あいまい検索(英) .MatchFuzzy = False 'あいまい検索(日) .MatchWildcards = False 'ワイルドカードを使用する .Execute Replace:=wdReplaceAll End With '蛍光ペンの色を元に戻す Options.DefaultHighlightColorIndex = myColor 'myRangeを解放 Set myRange = Nothing End Sub }} *グラフ作図(密度データ) [#r67ef280] #highlighter(VBScript){{ Sub Draw_Graph000() 'This program draw the graphs of volumetric and viscometric behaviors. Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Dim n As Integer Dim gpos_x As Integer Dim gpos_y As Integer Dim g_width As Integer Dim g_hight As Integer Dim chartObj As ChartObject Dim ans As Integer Dim graph_name As String Dim data_number(20) As Integer Dim alcohol As String Dim strSheetName As String strSheetName = ActiveSheet.Name ' アクティブシート上に既存のグラフがあれば削除 If ActiveSheet.ChartObjects.Count > 0 Then For i = 1 To ActiveSheet.ChartObjects.Count ' グラフ名が一致するか If ActiveSheet.ChartObjects(i).Name = graph_name Then ActiveSheet.ChartObjects(i).Delete Exit For End If Next i End If alcohol = strSheetName physical_value = "density" If alcohol = "methanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "ethanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "1-propanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K ElseIf alcohol = "2-propanol" Then n = 7 data_number(1) = 4 '351K data_number(2) = 4 '373K data_number(3) = 4 '476K data_number(4) = 3 '523K data_number(5) = 3 '573K data_number(6) = 3 '618K data_number(7) = 3 '673K End If For i = 1 To n 'グラフの位置 gpos_x = 420 * (1 - 1) + 100 gpos_y = 299 * (i - 1) + 300 'グラフのサイズ g_width = 90 * 4 g_hight = 90 * 3 ' グラフ識別子 graph_name = "numbered_entry" 'Objects追加位置(左位置, 上位置, 幅, 高さ) Set chartObj = ActiveSheet.ChartObjects.Add(gpos_x, gpos_y, g_width, g_hight) chartObj.Name = graph_name 'ChartArea設定 chartObj.Chart.ChartArea.Format.Line.Visible = msoFalse With chartObj.Chart 'ChartArea設定 .ChartArea.Format.Line.Visible = msoFalse .PlotArea.Select 'PlotArea設定(暫定) With Selection .Format.Line.ForeColor.ObjectThemeColor = msoThemeColorText1 'plot area枠を黒に .Height = 230 .Width = 320 .Top = 5 .Left = 25 End With For j = 1 To data_number(i) 'データ設定 If j <> 1 Then .SeriesCollection.NewSeries End If With .SeriesCollection(j) l = 20 For k = 1 To i - 1 l = l + data_number(k) * 20 Next k l = l + 20 * (j - 1) .Values = Range(Cells(l + 1, 4), Cells(l + 20, 4)) .XValues = Range(Cells(l + 1, 3), Cells(l + 20, 3)) .Name = Cells(l + 1, 13) .ChartType = xlXYScatterLines '以下散布図線付き時のみ With .Format.Line '線を作画するか .Visible = msoTrue '線の太さ .Weight = 0.5 '点線 '.DashStyle = msoLineSysDash .ForeColor.RGB = RGB(127 * (Int(j / 9) Mod 3), 127 * (Int(j / 3) Mod 3), 127 * (Int(j) Mod 3)) End With '.ChartType = xlXYScatter '散布図 .MarkerStyle = xlMarkerStyleCircle 'マーカー (丸) .MarkerSize = 5 .MarkerBackgroundColorIndex = 0 'マーカー塗りつぶしの色 .MarkerForegroundColor = RGB(127 * (Int(j / 9) Mod 3), 127 * (Int(j / 3) Mod 3), 127 * (Int(j) Mod 3)) End With Next j 'グラフタイトル .HasTitle = True With .ChartTitle .Text = alcohol .Left = 60 .Top = 15 With .Format.TextFrame2.TextRange.Font .Bold = msoFalse .Size = 10 'MS P ゴシック .Name = "+mj-ea" End With End With 'x軸タイトル With .Axes(xlCategory, xlPrimary) .HasTitle = True With .AxisTitle .Font.Bold = msoFalse If alcohol = "methanol" Then .Characters.Text = "xm" 'ここでの(1, 1)は文字の範囲を指定 .Characters(1, 1).Font.FontStyle = "italic" '下付き .Characters(2, 1).Font.Subscript = True ElseIf alcohol = "ethanol" Then .Characters.Text = "xe" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 1).Font.Subscript = True ElseIf alcohol = "1-propanol" Then .Characters.Text = "x1pro" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 5).Font.Subscript = True ElseIf alcohol = "2-propanol" Then .Characters.Text = "x2pro" .Characters(1, 1).Font.FontStyle = "italic" .Characters(2, 5).Font.Subscript = True Else .Characters.Text = "x" .Characters(1, 1).Font.FontStyle = "italic" End If .Characters.Font.Size = 12 End With End With 'y軸タイトル With .Axes(xlValue, xlPrimary) .HasTitle = True With .AxisTitle .Font.Bold = msoFalse .Characters.Text = "density / kg m-3" .Characters(15, 2).Font.Superscript = True End With End With 'x軸設定 With .Axes(xlCategory) .MaximumScale = 1 .MinimumScale = 0 .MajorTickMark = xlInside '軸目盛内向き .TickLabels.NumberFormatLocal = "G/標準" .MajorGridlines.Delete '補助線を削除 With .Format.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 End With End With 'y軸設定 With .Axes(xlValue) .MajorTickMark = xlInside .TickLabels.NumberFormatLocal = "G/標準" .MajorGridlines.Delete With .Format.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 End With End With '凡例設定 With .Legend .Left = 230 .Width = 100 .Height = 100 .Top = 100 End With End With Next i End Sub }}
テキスト整形のルールを表示する