戻る

Tips-ExcelVBA

VBAマクロばっかり(Tipsとは言えないかも)...多分 Excel97以上で動くと思います

※ ここで公開している手順やマクロ(VBA含む)等を利用して生じた不具合や、いかなる損害についても一切責任を負いかねます


[09/07]ステータスバーに処理状況表示
[09/07]確認メッセージを表示せずにシートを削除
[09/07]枠線を消す(メニュー-ツール(T)-オプション(O)-[表示]タブ-枠線(G)のチェックを外す)
[09/07]最後のシートの後にシートを追加
[09/07]別のシートからコピー(コピー先のシートを開いているとき)
文字で円を書く
すべてのシートのズーム倍率を変更する
各シートの最終行を新しいシートに作成

ExcelVBA ステータスバーに処理状況表示 2002/09/07

例)ステータスバーに■と□を使ってどのぐらい処理が進んでいるかを表示(10個で...のつもり...) Sub ステータスバーに処理状況表示() 　　Dim i As Integer, j As Integer 　　j = 7　　 '処理の個数 　　For i = 1 To j 　　　　Application.StatusBar = "処理中 " & String(i / j * 10, "■") & String(10 - (i / j * 10), "□")　　'ステータスバーに状況表示 　　　　MsgBox "処理" & i, vbInformation 　　Next i 　　Beep 　　MsgBox "処理が終了しました" 　　Application.StatusBar = False　　'ステータスバーをクリア End Sub

ページトップに戻る

ExcelVBA 確認メッセージを表示せずにシートを削除 2002/09/07

例)Sheet1を確認メッセージを表示しないで削除する Sub 確認無しシート削除() 　　Application.DisplayAlerts = False　　 '警告やメッセージを表示しない 　　Worksheets("Sheet1").Delete 　　Application.DisplayAlerts = True　　 '警告やメッセージを表示する End Sub

ページトップに戻る

ExcelVBA 枠線を消す(メニュー-ツール(T)-オプション(O)-[表示]タブ-枠線(G)のチェックを外す) 2002/09/07

Sub 枠線を消す() ActiveWindow.DisplayGridlines = False End Sub

ページトップに戻る

ExcelVBA 最後のシートの後にシートを追加 2002/09/07

Sub 最後のシートの後にシートを追加() 　　Sheets.Add After:=Sheets(Sheets.Count)　　　'最後のシートの後にシートを追加 　　ActiveSheet.Name = "新シート名"　　　　　　　 'カレントシートの名前変更(ここで追加されたシート) End Sub

ページトップに戻る

ExcelVBA 別のシートからコピー(コピー先のシートを開いているとき) 2002/09/07

例)Sheet1の1行目から5行目を現在開いているシートの10行目からコピーする Sub 別のシートからコピー() 　　Sheets("Sheet1").Rows("1:5").Copy　　 'Sheet1の１行目から５行目までをクリップボードにコピー 　　Cells(10, 1).Activate　　　　　　　　　　　　 '現在開いているシートの10行目にカーソルを移動 　　ActiveSheet.Paste　　　　　　　　　　　　　 '貼り付け(前の行で移動した10行目) End Sub

ページトップに戻る

ExcelVBA 文字で円を書く 2002/08/29

例)シートに半径25(セル)で円を書く Sub en() 　　 ' 円を書く(なぜか楕円...続けて3回実行すると円になる...) 　　Dim han As Long, i As Long, tmp As Double 　　Dim x As Long, y As Long 　　ActiveWindow.Zoom = 50　　　　'ズーム50% 　　Cells.ShrinkToFit = True　　　　'(セル)縮小して全体を表示する 　　tmp = (Columns(1).ColumnWidth / Columns(1).Width) 　　Cells.ColumnWidth = Rows(1).RowHeight * tmp　　　　'列幅を行の高さと同じにする 　　han = 25　　　　'半径 　　For i = 0 To 360 　　　　x = han * Cos(((i + 270) Mod 360) / 180 * 3.1415) 　　　　y = han * Sin(((i + 270) Mod 360) / 180 * 3.1415) 　　　　Cells(y + han + 2, x + han + 1) = i 　　Next i 　　Beep 　　MsgBox "円を書きました" End Sub

ページトップに戻る

ExcelVBA すべてのシートのズーム倍率を変更する 2002/08/29

例)すべてのシートを125%に変更する Sub Macro1() 　　Dim i As Integer 　　For i = 1 To Sheets.Count 　　　　Sheets(i).Select 　　　　ActiveWindow.Zoom = 125　　　　　'ここの 125 が倍率なので、200倍にする場合は200に変更する 　　Next i End Sub

ページトップに戻る

ExcelVBA 各シートの最終行を新しいシートに作成 2002/08/29

例)各シートの一番下の行に合計がある時に、その総合計を出したいが＝と＋で計算するのがめんどくさい時 Sub シート最終行() 　　Dim sh As Integer, Msh As Integer 　　Dim y As Long, sy As Long 　　Dim x As Integer 　　Dim flg As Boolean 　　Msh = Sheets.Count 　　Sheets.Add After:=Sheets(Sheets.Count) 　　ActiveSheet.Name = "★最終行集計" 　　ActiveWindow.DisplayGridlines = False 　　sy = 0 　　For sh = 1 To Msh 　　　　sy = sy + 1 　　　　y = 0 　　　　flg = False 　　　　Do Until flg = True 　　　　　　y = y + 1 　　　　　　For x = 1 To 253 　　　　　　　　If Sheets(sh).Cells(y + 1, x) <> "" Then 　　　　　　　　　　Exit For 　　　　　　　　End If 　　　　　　Next x 　　　　　　If x = 253 + 1 Then 　　　　　　　　flg = True 　　　　　　End If 　　　　Loop 　　　　Sheets(sh).Range("A" & y & ":IT" & y).Copy 　　　　Cells(sy, 3).Select 　　　　Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ 　　　　　　　　　　　　　　　　　　　　　　　　SkipBlanks:=False, Transpose:=False 　　　　Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ 　　　　　　　　　　　　　　　　　　　　　　　　SkipBlanks:=False, Transpose:=False 　　　　Cells(sy, 1) = Sheets(sh).Name 　　　　Cells(sy, 2) = y 　　Next sh 　　Cells(1, 1).Activate End Sub

ページトップに戻る