| 41 | 複数についたセルの色を別の色に一気に変えるには |
| Sub
ColorConv() Dim c As Range For Each c In Selection With c.Interior If .Color = vbYellow Then .Color = vbRed End With Next End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 他の色にするには vbRed のところを以下のようにします。 vbBlack 黒 vbGreen 緑 vbYellow 黄 vbBlue 青 vbMagenta マゼンタ vbCyan シアン vbWhite 白 |
|
| 42 | 総ページ数を表示 http://www.ae.wakwak.com/cgi-bin/sbox/~efc21/wwwlng.cgi?print+200203/02030059.txt 「シートのページ数を知るには？」 【VBAラウンジ】 http://www.keep-on.com/excelyou/2000lng1/200011/00110146.txt 「ページ数を自動計算させるにはどうすれば？」 【編集ラウンジ】 |
| アクティブシートのA列にシート名、B列にページ数を入力します。 Sub test() Dim WS As Worksheet, c As Worksheet Dim i As Integer Set WS = ActiveSheet Application.ScreenUpdating = False For Each c In Worksheets c.Activate i = i + 1 WS.Cells(i, 1) = c.Name WS.Cells(i, 2) = Application.ExecuteExcel4Macro("Get.Document(50)") Next WS.Activate Application.ScreenUpdating = True End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| Sub
総ページ数を表示() Dim Lastpage As Integer Lastpage = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1) MsgBox Lastpage End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 43 | 計算結果のエラー値の一覧 |
| ＃ＤＩＶ／０！ | 数式で、０による割り算が行われた時に表示されます。空白セルの場合も同様。 |
| ＃Ｎ／Ａ | 検索関数の引数として、検索値の近似値が見つからない場合に表示されます。 |
| ＃ＮＡＭＥ？ | 関数の名前を間違った時に表示されます。 |
| ＃ＮＵＬＬ！ | セル参照の指定が間違っていて、参照されるセルが存在しない場合に表示されます。 |
| ＃ＮＵＭ！ | 数式の数値が不適切な場合に表示されます。 |
| ＃ＲＥＦ | 数式中で、無効なセルを参照した場合に表示されます。 |
| ＃ＶＡＬＵＥ！ | 引数や演算子の種類が正しくない時に表示されます。 |
| ＃＃＃＃＃＃ | セルの幅が不足して結果が表示できない場合に表示されます。 |
| 44 | エクセルで、「碁盤」を作りたい http://www.keep-on.com/excelyou/2001lng5/200101/01010100.txt 「エクセルで、「碁盤」を作りたい。」 【その他ラウンジ】 |
| 【注意】 このマクロは、Excel2002ではエラーが出ます。 先にこちらの方法でエラーチェックを解除してから実行してください。 ※ 【ツール】 【マクロ】 【セキュリティ】 の 【信頼のおけるソース元】 で、 【Visual Basic プロジェクトへのアクセスを信頼する】にチェックを入れてください。 また、このコードはウイルスチェックに，引っかかっることもあるようですので、ご注意ください。 【使い方】 |
|
| 45 | チェックする人をパスワードで限定する方法は？ http://www.keep-on.com/excelyou/2000lng5/200008/00080010.txt 「チェックボックスにチェックする人を限定する方法は？」 【その他ラウンジ】 |
| シートの記入例です。 A B C D 1 わらびし Yon ミコ しろくま ←名前をクリックし、パスワードを入力すると 2 未 未 未 未 ←"済"になります *****途中省略****** 100 1111 2222 3333 4444 ←あらかじめパスワードを入れておきます 101 未 未 未 未 ←これも入れておきます 登録者にパスワードを申請してもらい、シートのずっと下方の、使用しない 行のセルに各々記入しておきます。 下の例では、１００行目のセルに、それぞれ Ａ１〜＊＊１セルの人物に対応するパスワードを 記入しておきます。文字色を白にするか、非表示にするといいかもしれません。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim Nam As String ' 一行目以外を Double Click しても何も起きない If Target.Row <> 1 Then Exit Sub ' Double Click したセルが空欄でなかったら（名前が書いてあったら） If IsEmpty(Cells(1, Target.Column)) = False Then Nam = InputBox("パスワードを記入してください。", "Password ?", "****") End If ' Password が正しい時 If Nam = Cells(100, Target.Column).Value Then ' 100行目の Password ' 閲覧済でない時 If Cells(2, Target.Column).Value <> "済" Then Cells(2, Target.Column) = "済" Cells(2, Target.Column).Font.ColorIndex = 1 ' "済" の文字色 Cells(101, Target.Column) = "済" ' 閲覧済の時 ElseIf Cells(2, Target.Column).Value = "済" Then Cells(2, Target.Column) = "未" Cells(2, Target.Column).Font.ColorIndex = 3 ' "未" の文字色 Cells(101, Target.Column) = "未" End If Else MsgBox ("パスワードが違います。") End If Cancel = True End Sub Private Sub Worksheet_Activate() Rows(11).Copy Cells(2, 1).Select Selection.PasteSpecial xlValue Application.CutCopyMode = False Cells(1, 1).Select End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| こういうシートの場合 A B C D E 1 わらびし Yon ミコ しろくま 2 8/1 未 未 未 未 3 8/2 未 未 未 未 4 8/4 未 未 未 未 *****途中省略****** 100 1111 2222 3333 4444 ←パスワードをあらかじめ入力しておきます Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim Nam As String ' 一行目以外を Double Click しても何も起きない If Target.Row = 1 Then Exit Sub Nam = InputBox("パスワードを記入してください。", "Password ?", "*****") ' Password が正しい時 If Nam = Cells(100, Target.Column).Value Then ' 100行目の Password ' 閲覧済でない時 If Selection.Value <> "済" Then Selection = "済" Selection.Font.ColorIndex = 1 ' "済" の文字色 ' 閲覧済の時 ElseIf Selection.Value = "済" Then Selection = "未" Selection.Font.ColorIndex = 3 ' "未" の文字色 End If Else MsgBox ("パスワードが違います。") End If Cancel = True End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| 46 | １つの数字を打ち込んだらEnterキー押さないでも、右隣のセルに移動させるには http://www.keep-on.com/excelyou/2001lng5/200102/01020042.txt 「1桁数字を１個のセルに入力するときにリターンキーを押さないで入力する方法」【その他ラウンジ】 http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200612/06120037.txt 「Enterを押さずに、ワークシートに１桁の数値入力していくには」 |
| 下の２種類のコードを使用します。入力モードを直接入力にして下さい。 Private Sub Worksheet_Activate() Dim i As Integer For i = 0 To 255 Select Case i Case Asc("0") To Asc("9") Application.OnKey Chr(i), "'nextrow """ & Chr(i) & """'" Application.OnKey "{" & i + 48 & "}", "'nextrow """ & Chr(i) & """'" ' a〜z、A〜Zにも対応する場合、次の２行も使います。 ' Case Asc("A") To Asc("Z"), Asc("a") To Asc("z") ' Application.OnKey Chr(i), "'nextrow """ & Chr(i) & """'" End Select Next i End Sub Private Sub Worksheet_Deactivate() Dim i As Integer For i = 0 To 255 Select Case i Case Asc("0") To Asc("9") Application.OnKey Chr(i) Application.OnKey "{" & i + 48 & "}" ' a〜z、A〜Zにも対応する場合、次の２行も使います。 ' Case Asc("A") To Asc("Z"), Asc("a") To Asc("z") ' Application.OnKey Chr(i) End Select Next i End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 Sub nextrow(str As String) |
|
| 範囲を指定する場合。（C〜R列に対応）入力モードを直接入力にして下さい。 Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim i As Integer 'C〜R列の範囲のみ If Target.Column > 2 And Target.Column < 19 Then For i = 0 To 255 Select Case i Case Asc("0") To Asc("9") Application.OnKey Chr(i), "'nextrow """ & Chr(i) & """'" Application.OnKey "{" & i + 48 & "}", "'nextrow """ & Chr(i) & """'" End Select Next i Else For i = 0 To 255 Select Case i Case Asc("0") To Asc("9") Application.OnKey Chr(i) Application.OnKey "{" & i + 48 & "}" End Select Next i End If End Sub Private Sub Worksheet_Deactivate() Dim i As Integer For i = 0 To 255 Select Case i Case Asc("0") To Asc("9") Application.OnKey Chr(i) Application.OnKey "{" & i + 48 & "}" End Select Next i End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 Sub nextrow(str As String) |
|
| 下の２種類のコードを使用します。入力モードを直接入力にして下さい。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Application 'キーボードのコード .OnKey "1", "'NextCell 1'" .OnKey "2", "'NextCell 2'" .OnKey "3", "'NextCell 3'" .OnKey "4", "'NextCell 4'" .OnKey "5", "'NextCell 5'" .OnKey "6", "'NextCell 6'" .OnKey "7", "'NextCell 7'" .OnKey "8", "'NextCell 8'" .OnKey "9", "'NextCell 9'" .OnKey "0", "'NextCell 0'" 'テンキーのコード .OnKey "{97}", "'NextCell 1'" .OnKey "{98}", "'NextCell 2'" .OnKey "{99}", "'NextCell 3'" .OnKey "{100}", "'NextCell 4'" .OnKey "{101}", "'NextCell 5'" .OnKey "{102}", "'NextCell 6'" .OnKey "{103}", "'NextCell 7'" .OnKey "{104}", "'NextCell 8'" .OnKey "{105}", "'NextCell 9'" .OnKey "{96}", "'NextCell 0'" End With End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 Sub NextCell(ByVal Index As Integer) With ActiveCell .Value = Index If .Column = 256 Then Beep: Exit Sub .Offset(0, 1).Select End With End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 このマクロの場合は、標準モジュールを実行する必要はありません。 上のコードを貼り付けたシートで、入力するだけで実行されます。 ※ 右隣ではなく下に移動させる場合は、 .Offset(0, 1).Select の部分を .Offset(1, 0).Select に変更します。 |
|
| Private Sub Worksheet_Change(ByVal Target
As Range) Dim ALen As Integer, i As Integer Dim MySt As String With Target If Not IsNumeric(.Value) Then Exit Sub ALen = Len(.Value) If .Column + ALen > 256 Then MsgBox "最大入力列を超えてしまいます。", 48 Exit Sub End If .Value = "'" & .Value For i = 1 To ALen MySt = MySt & "[" & Mid(.Value, i, 1) & "]" Next i .Parse MySt End With End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| 47 | 全シートの保護と解除 http://www.keep-on.com/excelyou/2001lng1/200104/01040138.txt 「sheetを保護してオートフィルター機能を使用」 【編集ラウンジ】 |
| Sub 保護の設定() Dim Sh As Worksheet x = Application.InputBox("バスワードを入力して下さい", Type:=3) For Each Sh In Worksheets Sh.Protect (x) Next Sh End Sub Sub 保護の解除() Dim Sh As Worksheet On Error GoTo ErLine Do x = Application.InputBox("バスワードを入力して下さい", Type:=3) Loop While x = "False" For Each Sh In Worksheets Sh.Unprotect Password:=x Next Sh Exit Sub ErLine: y% = MsgBox("パスワードが違います ! 終了します", 48) End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 48 | メール返信用の引用記号を挿入 |
| 1. 受け取ったメールの画面で
Ctrl+A → Ctrl+C で全文をコピーします。 2. マクロを実行すると、アクティブなシートのＡ列に、引用記号をつけて表示します。 ※ マクロ（下のコード）の書き方と、実行の仕方は、マクロの使い方(１)標準モジュールにあります。 3. マクロ終了時には変換後のデータがクリップボードにコピーされてるので、 そのままメモ帳や返信メールの画面に貼り付けます。 Sub 引用記号追加() On Error GoTo er1 With ActiveWorkbook.ActiveSheet .Select .Cells.ClearContents .Range("A1").Select .PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:=False With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Offset(0, 1) .FormulaR1C1 = "=IF(TRIM(RC[-1])="""","""","">""&TRIM(RC[-1]))" .Copy .PasteSpecial xlValues End With .Columns(1).Delete With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) .Copy End With End With Exit Sub er1: MsgBox "コピーしてから実行してください" End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 49 | フォルダ内の全てのファイル名をセルに表示するには |
| My Documents内の全て（下位フォルダ内を除く）のExcelファイル名を、アクティブなシートのＡ列に表示します。 Sub test() Dim BookName As String, PathName As String, i As Integer PathName = "C:\My Documents\" BookName = Dir(PathName & "*.xls") Do Until BookName = "" i = i + 1 Cells(i, 1) = BookName BookName = Dir() Loop End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 50 | 変数名の規則 |
| 使える文字 | 英字（大文字小文字は区別しません）、カタカナ、ひらがな、漢字 |
| 使えない文字 | 【スペース】、【ピリオド（ドット . ）】、【感嘆符！）】、【＠】、【＆】、【＄】、【＃】 |
| 使えない単語 | ＶＢＡで使用している【関数】、【ステートメント】、【メソッド】 |
| 文字数 | 半角で２５５文字以内。全角、半角の混合も可、ただし全角は半角の２文字分。 |
| 名前の先頭は必ず文字にする 同じプロシージャの中で、同じ名前の変数は使用できません。 |
|
| 51 | 順列組み合せ |
| 下のように、果物が全部で１０個の場合の組み合わせ数を全て表示します。任意の個数を指定できます。 りんご みかん イチゴ メロン すいか 0 0 0 0 10 0 0 0 1 9 0 0 0 2 8 途 中 省 略 9 0 1 0 0 9 1 0 0 0 10 0 0 0 0 Sub Kumiawase() |
|
| 52 | セルの中でタブキーを押したときに任意の数のスペースを空け、 そのままセル内に続けて入力するには？ http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200106/01060120.txt 「セルの中でタブを使うには？」 【編集ラウンジ】 |
| Sub TAB開始() Application.OnKey "{TAB}", "TAB設定" End Sub Sub TAB解除() Application.OnKey "{TAB}" End Sub Sub TAB設定() ActiveCell.Value = ActiveCell.Value & " " 'ＴＡＢを押した時に入れたい任意の数のスペースを入れます SendKeys "{F2}" End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 設定を実行する場合、「TAB開始」のマクロを実行してください。 こちらの「OnKeyメソッドのマクロを、他のシート、他のファイルで実行させない為には」もあわせてご覧ください。 |
|
| 53 | 合計金額、合計個数を指定して、すべての組み合わせを表示したい |
| 以下のように、Sheet1に入力して実行すると、Sheet2に結果を表示します。 ***** Sheet1 ***** A B C D E F 1 商品1 商品2 商品3 商品4 商品5 商品6 2 9800 8800 7800 7000 6800 5800 ***** Sheet2 ***** A B C D E F G H I J K L M N 1 商品1 商品2 商品3 商品4 商品5 商品6 合 計 2 9800 8800 7800 7000 6800 5800 19 133400 3 0 0 0 0 1 7800 16 112000 2 13600 0 0 4 0 0 0 0 2 15600 11 77000 6 40800 0 0 コードの使い方ですが、 1. Alt＋F11 で、VBEの画面を出します。 2. 左側のプロジェクト-VBAProjectで、該当するファイルを選択します。 VBAProjectが出ていなければ、Ctrl＋R で出します。 3. [挿入]、[標準モジュール]、出てきた白い所に、コードを貼付けます。 4. 右上の × でExcelの画面に戻ります。 5. Alt＋F8 でマクロの名前を選んで、実行します。 Sub miko_test() Dim i As Long, j As Long, k As Long, shou As Long Dim m As Long, n As Long, o As Long, myRange As Range Dim x As Long, y As Long, z As Long, a As Long Dim kingaku(6) As Long, soku(6) As Long Sheets("Sheet2").Select With Sheets("Sheet1") Cells.ClearContents Cells(1, 1) = .Cells(1, 1) Cells(1, 3) = .Cells(1, 2) Cells(1, 5) = .Cells(1, 3) Cells(1, 7) = .Cells(1, 4) Cells(1, 9) = .Cells(1, 5) Cells(1, 11) = .Cells(1, 6) Cells(1, 13) = "合 計" Cells(2, 2) = .Cells(2, 1) Cells(2, 4) = .Cells(2, 2) Cells(2, 6) = .Cells(2, 3) Cells(2, 8) = .Cells(2, 4) Cells(2, 10) = .Cells(2, 5) Cells(2, 12) = .Cells(2, 6) kingaku(1) = .Cells(2, 1) kingaku(2) = .Cells(2, 2) kingaku(3) = .Cells(2, 3) kingaku(4) = .Cells(2, 4) kingaku(5) = .Cells(2, 5) kingaku(6) = .Cells(2, 6) With Range("A1:N2").Font .Size = 12 .ColorIndex = 5 .Bold = True End With Set myRange = .Range("A2:F2") shou = Application.WorksheetFunction.Min(myRange) On Error Resume Next Do y = InputBox("合計金額を入力してください？", "?", 133400) z = InputBox("合計足数を入力してください？", "?", 19) If Err <> 0 Then Err = 0: Exit Sub y = Int(y) z = Int(z) If y < shou Or z < 1 Then Exit Sub Else Cells(2, 14) = y Cells(2, 13) = z Exit Do End If Loop On Error GoTo ErrH x = 3 For i = 0 To y Step kingaku(1) soku(1) = i / kingaku(1) For j = 0 To y Step kingaku(2) soku(2) = j / kingaku(2) For k = 0 To y Step kingaku(3) soku(3) = k / kingaku(3) For m = 0 To y Step kingaku(4) soku(4) = m / kingaku(4) For n = 0 To y Step kingaku(5) soku(5) = n / kingaku(5) For o = 0 To y Step kingaku(6) soku(6) = o / kingaku(6) If i + j + k + m + n + o = y And _ soku(1) + soku(2) + soku(3) + soku(4) + soku(5) + soku(6) = z Then Cells(x, 2).Value = i Cells(x, 4).Value = j Cells(x, 6).Value = k Cells(x, 8).Value = m Cells(x, 10).Value = n Cells(x, 12).Value = o Cells(x, 1).Value = soku(1) Cells(x, 3).Value = soku(2) Cells(x, 5).Value = soku(3) Cells(x, 7).Value = soku(4) Cells(x, 9).Value = soku(5) Cells(x, 11).Value = soku(6) x = x + 1 End If Next Next Next Next Next Next End With Exit Sub ErrH: Err = 0 On Error GoTo 0 MsgBox ("オーバーフローしました。") End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 54 | セルを選択したとき、F2を押さずに自動的に編集状態にするには？ http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200107/01070038.txt 「常に「編集」の状態にするには？」 【編集ラウンジ】 |
| Excel2002確認済 Private Sub Worksheet_SelectionChange(ByVal Target As Range) SendKeys "{F2}" End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| 55 | セルの中で、複数の単語を間隔を空けてきれいに整列させて表示するには？ http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200106/01060120.txt 「セルの中でタブを使うには？」 【編集ラウンジ】 |
| Excel2002確認済 （１）図のように、当該シートのＡ１セルに、ＴＡＢの長さに相当する半角スペースの数を記入しておきます。 間隔を空けたい所まで入力したら、スペースを押してください。Enterで決定後、等間隔に表示します。 プロポーショナルフォント以外（ＭＳ 明朝、ＭＳ ゴシック）で実行してください。  Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim s As String, s1 As String Dim sLen As Integer, sp As Integer Dim n As Integer, m As Integer On Error Resume Next s = Target.Value If Err <> 0 Then Exit Sub sLen = Len(s) s1 = Left(s, 1) ' すでにスペースが連続している場合には、それを一つだけにしておく If sLen >= 3 Then For n = 2 To sLen If (Right(Left(s, n), 1) = Chr(32) _ Or Right(Left(s, n), 1) = Chr(-32448)) _ And (Right(Left(s, n - 1), 1) = Chr(32) _ Or Right(Left(s, n - 1), 1) = Chr(-32448)) Then s1 = s1 Else s1 = s1 & Right(Left(s, n), 1) End If Next Application.EnableEvents = False Target.Value = s1 Application.EnableEvents = True End If ' 改めてスペースを挿入 s = Target.Value If Err <> 0 Then Exit Sub sLen = Len(s) s1 = "" sp = Cells(1, 1).Value If Err <> 0 Then Err = 0: sp = 6 ' スペースの数が適当でないときは６とする If sp > 20 Then sp = 20 ' 同じく２０を越えていたら２０とする If sp < 1 Then sp = 1 ' 同じく１未満なら１とする m = 0 For n = 1 To sLen If Right(Left(s, n), 1) = Chr(32) _ Or Right(Left(s, n), 1) = Chr(-32448) Then If m = sp Then m = sp - 1 ' 指定のスペース数から文字数分を引いてスペース挿入 s1 = s1 & Space(sp - m) sLen = sLen + sp - m m = 0 ElseIf Right(Left(s, n), 1) = Chr(10) Then s1 = s1 & Chr(10) ' 文字が LineFeed ならカウンタをリセット m = 0 Else s1 = s1 & Right(Left(s, n), 1) ' 文字の全/半角により、挿入スペース数を変える If Asc(Right(Left(s, n), 1)) < 0 Then ' 全角 m = m + 2 Else ' 半角 m = m + 1 End If End If Next Application.EnableEvents = False Target.Value = s1 Application.EnableEvents = True On Error GoTo 0 End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| 56 | シートを保護した状態で、ロックしていないセルの書式等が変更できません。 http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200107/01070157.txt 「特定のセルを保護すると他のセルの編集ができない。」 【編集ラウンジ】 |
| Excel2002確認済 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Selection.Locked = True Then '選択範囲にロックがかかっている場合 ActiveSheet.Protect 'シートを保護する ElseIf Selection.Locked = False Then '選択範囲にロックがかかっていない場合 ActiveSheet.Unprotect 'シートの保護を解除する End If End Sub このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。 |
|
| 57 | 選択範囲のセルを、縦方向に結合するには |
| Excel2002確認済 Sub 縦方向にセルを結合() Dim a As Long, b As Integer, aa As Integer, bb As Integer, aaa As String, i As Integer a = Selection.Row b = Selection.Column aa = Selection.Rows(Selection.Rows.Count).Row bb = Selection.Columns(Selection.Columns.Count).Column For i = b To bb Range(Cells(a, i), Cells(aa, i)).Select Selection.Merge Next End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 58 | 個数・方向を指定して結合するには |
| Excel2002確認済 Sub miko_test() Dim k As Integer, ko As Integer, a As Integer, ho As String Dim i As Integer, j As Integer, m As Integer On Error GoTo er1 k = Application.InputBox(prompt:="何個づつのセルを結合しますか？", Default:=2, Type:=1) If k = 0 Then Exit Sub ko = Application.InputBox(prompt:="何組の結合セルを作りますか？", Default:=3, Type:=1) If ko = 0 Then Exit Sub ho = InputBox(prompt:="現在のセルの右または左から結合します。どっちの方向に結合しますか？" _ & Chr(10) & " " & Chr(10) & " 1)縦方向 2)横方向", Default:=1) If ho = 1 Then '縦方向の結合 i = ActiveCell.Row + 1 j = ActiveCell.Column Range(Cells(i, j), Cells(i + k * ko - 1, j)).UnMerge For m = i To i - 1 + k * ko Step k Range(Cells(m, j), Cells(m + k - 1, j)).Merge Next End If If ho = 2 Then '横方向の結合 i = ActiveCell.Row j = ActiveCell.Column + 1 Range(Cells(i, j), Cells(i, j + k * ko - 1)).UnMerge For m = j To j - 1 + k * ko Step k Range(Cells(i, m), Cells(i, m + k - 1)).Merge Next End If er1: End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| 59 | ツールバー・メニューバー、タイトルバーの右クリックメニューを表示、非表示を切り替えるには？ http://www.keep-on.com/~excelyou/2000lng4/200007/00070249.txt 「右ボタンを使用不可にする方法を教えて下さい」 【VBAラウンジ】 |
| Excel2002確認済 Sub メニューバー､ツールバーの右クリックメニュー表示切替() Dim CB As CommandBar Dim CBP As CommandBarPopup Set CB = Application.CommandBars("Worksheet Menu Bar") Set CBP = CB.Controls("表示(&V)").Controls("ツールバー(&T)") CBP.CommandBar.Enabled = Not CBP.CommandBar.Enabled Set CB = Nothing Set CBP = Nothing End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|
| Excel2002確認済 Const GWL_STYLE = -16& Const WS_SYSMENU = &H80000 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Sub
システムメニュー消去() 'タイトルバーの右クリックメニューを消す Sub
システムメニュー復活() |
|
| 60 | マウスでの、ドラッグ、ドロップを禁止するには？ http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200109/01090073.txt 「行挿入・行削除・コピー・ペーストだけ禁止するには。」 【VBAラウンジ】 |
| Sub test() Application.CellDragAndDrop = False 'マウスでのドラッグ＆ドロップを禁止 Application.CellDragAndDrop = True '禁止を解除 End Sub このコードの使い方は、マクロの使い方(１)標準モジュールにあります。 |
|