HOME >書き換えて学ぶExcel VBA |
HOME News for Paperless |
||
書き換えて学ぶExcel VBA | |||
---|---|---|---|
・VBAエジターはどこ? ・グラフをgifファイルで保存
・コンボボックスにアイテムを追加する
・スクロールバーを左上に寄せる
・クリップボードにテキストを送る
・クリップボードからテキストを受け取る
・外部ファイル・プログラムの起動
次の動画を見てください "ExcelのグラフはVBAを使って自動的にgifなどの画像ファイル形式に保存することができます。 この例では、データ列を次々に変えながらグラフをgifファイル形式に保存します。 シートの1行目2列目のセルに、保存先フォルダのパスを記入してください。(デフォルトはCドライブ直下にしています) Private Sub CommandButton1_Click() Dim Cnum As Integer Dim StrCnum As String Dim SDir As String With Sheet1 SDir = .Cells(1, 2) .Shapes.AddChart.Select 'グラフの種類設定 ActiveChart.ChartType = xlColumnClustered '最初のデータソースを設定(任意のセル範囲でよい) ActiveChart.SetSourceData Source:=Range(""A1:A1"") 'y軸の最小値を0に固定 ActiveChart.Axes(xlValue).MinimumScale = 0 'y軸の最大値を20に固定 ActiveChart.Axes(xlValue).MaximumScale = 20 ' 凡例を削除 ActiveChart.Legend.Delete 'x軸のラベルの角度指定 ActiveChart.Axes(xlCategory).TickLabels.Orientation = 30 for Cnum = 2 to 5 '参照データ 2列目から5列目まで ' 参照するセルの範囲 R1C1形式が便利 ActiveChart.SeriesCollection(1).Values = ""=Sheet1!R3C"" & Cnum & "":R17C"" & Cnum ' X軸ラベルの範囲 ActiveChart.SeriesCollection(1).XValues = ""=Sheet1!R3C1:R17C1"" '2→02 3→03 となるように設定 StrCnum = Right(CStr(100 + Cnum), 2) 'gifファイルへエクスポート ActiveChart.Export Filename:=SDir & ""graph"" & StrCnum & "".gif"" Next Cnum '次のデータ列へ End With MsgBox ""おわり"" End Sub" "Excelのコンボボックスにアイテムを追加するには、AddItemメソッドを使用します。下記の例では、「コンボテスト」という名前のシート の1列目の1行目から10行目までに入力されている文字列を「ComboBox1」という名前のコンボボックスにアイテムとして追加します。 Private Sub CommandButton1_Click() ComboBox1.Clear for i = 1 to 10 ComboBox1.AddItem Worksheets(""コンボテスト"").Cells(i, 1).Value Next i End Sub サンプルファイルを実行してみるとわかりますが、上記のプログラムを実行するとコンボボックスにはアイテムが重複して出現します。 残念ながらExcelのコンボボックスには重複アイテムを削除するようなプロパティがありませんので、追加するときに少し工夫をしてアイテムが重複しないように する必要があります。そこで下記のように、Collectionオブジェクトが重複したインデックスでアイテムを追加するとエラーが出るという性質を利用したプログラムを 作ります。 Private Sub CommandButton2_Click() ComboBox1.Clear Dim アイテムリスト As New Collection for i = 1 to 10 On Error Resume Next アイテムリスト.Add Worksheets(""コンボテスト"").Cells(i, 1).Value, _ CStr(Worksheets(""コンボテスト"").Cells(i, 1).Value) If Err.Number = 0 Then ComboBox1.AddItem Worksheets(""コンボテスト"").Cells(i, 1).Value End If Next i End Sub 「Collection.Add A,B」は、「AというアイテムをBというインデックスを付けて追加する」というメソッドです。このときA(アイテム)は重複しても 大丈夫なのですが、B(インデックス)を重複させるとエラーがでます。つまりすでに追加していたアイテムを追加しようとすると、Err.Numberは0 になりません。したがってComboBox1にアイテムは追加されません。" " Excelで表や報告書を作成して、大量のブックやシートができてしまったとき、各ブックやシートのスクロールバーの位置やセル選択の位置が ばらばらになってしまって見にくいときがあります。官公庁が公表している統計表などでも大変見にくい(醜い)ものがあります。内輪で閲覧するだけならいいのですが、社外に提出するような文書の場合には見栄えもきちんとしておきたいものです。 下のサンプルは、同じフォルダ階層にあるすべてのExcelファイルのすべてのシートのスクロールバーを左上に寄せて、A1のセルを選択した状態で保存するプログラムです。 Private Sub CommandButton1_Click() Dim WB As Workbook Dim BN As String Dim s As Integer Dim c As Integer BN = Dir(ThisWorkbook.Path & ""¥*.xls*"", vbNormal) Do While BN <> """" If BN <> ThisWorkbook.Name Then Workbooks.Open Filename:=ThisWorkbook.Path & ""¥"" & BN Set WB = Workbooks(BN) for s = 1 to WB.Sheets.Count WB.Sheets(s).Activate ActiveWindow.ScrollRow = 1 ActiveWindow.ScrollColumn = 1 ActiveSheet.Cells(1, 1).Select Next s c = WB.Sheets(1).Cells(1, 1).Font.ColorIndex WB.Sheets(1).Cells(1, 1).Font.ColorIndex = c + 1 WB.Close savechanges:=True Workbooks.Open Filename:=ThisWorkbook.Path & ""¥"" & BN Set WB = Workbooks(BN) WB.Sheets(1).Cells(1, 1).Font.ColorIndex = c WB.Sheets(1).Activate WB.Close savechanges:=True End If BN = Dir Loop MsgBox ""完了しました"" End Sub プログラムを見ていただくとわかりますが、この例ではいったん保存したあと再度ファイルを開いて保存しなおしています。これは、スクロールバーやセルの選択などの 操作だけでは「上書き保存」にならないため変更が保存されないからです。そのため上記の例では整形操作とともにセルA1のフォントの色を変更して「上書き保存」を有効にして、 再度ファイルを開いてフォントの色を元に戻す、という操作をおこなっています。" "VBAを使ってクリップボードに文字列を送ることができます。 コードを実行するには参照設定にMicrosoft Forms 2.0 Object Library を指定する必要があります。Visual Basicの画面で「ツール」→「参照設定」で選択します。「参照可能なライブラリファイル」の一覧にあればそれをチェックしてOKを押します。ない場合には、右の「参照(B)」ボタンをクリックするとファイルダイアログが出てきますので、System32フォルダの中の""FM20.DLL""を選択して「開く」ボタンをクリックします。 以下の例では、ExcelのSheet1のA1のセルの値をクリップボードに送ります Private Sub CommandButton1_Click() Dim TCB As New DataObject Dim 文字列 As String 文字列 = Worksheets(""Sheet1"").Cells(1, 1).Value With TCB .SetText 文字列 .PutInClipboard End With End Sub " "今度はクリップボードの内容をVBAに送ります。VBA→クリップボードの場合と同じく、参照設定にMicrosoft Forms 2.0 Object Library を指定する必要があります。 サンプルファイルのボタンを押すと、クリップボードのテキストを読み込み、メッセージボックスに表示します。 Private Sub CommandButton1_Click() Dim FCB As New DataObject Dim DData As String With FCB .GetFromClipboard DData = .GetText MsgBox ""「"" & DData & ""」という文字がコピーされています"" End With End Sub" " VBAで外部のファイルを起動する場合には、Shell関数を使います。Shell関数の書式は、以下のようになります。 「戻り値」=Shell(「プログラムのパス」,「開くときのウインドウの状態」) ここで戻り値は、0:正常に終了 1:起動失敗 などとなる値です。 「プログラムのパス」には、起動するプログラム、たとえばメモ帳なら「C:¥windows¥notepad.exe」になりますが、プログラムでなくファイルを開きたい場合には、「プログラムのパス(空白)""ファイルのパス""」のように指定します。C:¥test.txtをメモ帳で開くには「C:¥windows¥notepad.exe ""C:¥test.txt""」のようにします。 少し複雑ですが、開きたいファイルのパスの側には「""」をつけていることに注意してください。String型の変数に文字列を代入する場合には、a=""moji""のようにすると、aという変数が「moji」という値を持つことになりますが、上記のファイルのパスの指定には「moji」ではなく「""moji""」のように「""」がついた値を代入しなくてはなりません。 ややこしいことに、VBAでは「""」は特殊文字になっています。これを正確に文字として認識させるためにはエスケープ文字を「""」の前に添付しなくてはなりませんが、さらにややこしいことに、VBAではエスケープ文字も「""」になります。「""」が何個もつながった形で指定しなくてはなりません。詳しくは下記のプログラム例を参考にしてください。 サンプルプログラムファイルの「Shell.xls」では、Cドライブ直下の「test.txt」というファイルをメモ帳で開くようにしています。セルのプログラムのパスや拡張子などを変更するとPDFファイルやExcelファイルなどもこれで開くことができます。 Private Sub CommandButton1_Click() Dim ファイルのあるフォルダ As String Dim ファイルの名前 As String Dim プログラムのパス As String Dim 拡張子 As String ファイルのあるフォルダ = Worksheets(""Sheet1"").Cells(1, 1) ファイルの名前 = Worksheets(""Sheet1"").Cells(2, 1) プログラムのパス = Worksheets(""Sheet1"").Cells(3, 1) 拡張子 = Worksheets(""Sheet1"").Cells(4, 1) Dim ファイルのパス As String ファイルのパス = ファイルのあるフォルダ & ""¥"" & ファイルの名前 & ""."" & 拡張子 Dim AppFp As String AppFp = プログラムのパス & "" """""" & ファイルのパス & """""""" '前の""""はスペース空ける '「""」が特殊文字であるため、スキップするための文字(エスケープ文字)「""」を前につける Dim a As Integer a = Shell(AppFp, vbNormalFocus) End Sub " |