HOME > エクセルVBA > サンプル > Range

Range


【ファイル名】Range.xlsm
【バージョン】Ver 1.0.2
【作成日】2015年02月17日
【更新日】2015年03月15日
【動作確認】Windows 7
【必要なソフト】Microsoft Excel 2010
【ダウンロード】Range.zip
【説明】Rangeのサンプルです。

注意 Excel 2007からセルの数が増えました。セル数はCountだとオーバーフローする場合があるので、CountLargeを使います。
メニュー

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="SAM">
        <group id="Group1" label="Range">
          <box id="Box1" boxStyle="horizontal">
 <!-- ■■■ プロパティ -->
            <menu id="PropertyMenu" label="プロパティ(&amp;P)" itemSize="normal" imageMso="PropertySheet" size="normal" keytip="P">
              <button id="AllowEditButton" label="AllowEdit(&amp;E)" supertip="編集可能かを表示します。" onAction="onAction" />
              <button id="AreasCountButton" label="RangeSelection.Areas.Count(&amp;A)" supertip="選択しているエリア数を表示します。" onAction="onAction" />
              <button id="BordersButton" label="Borders(&amp;B)" supertip="選択したセルに罫線を設定します。"  imageMso="BordersAll" onAction="onAction" />
              <button id="ColumnsCountButton" label="Columns.Count(&amp;C)" supertip="選択した列の数を表示します。" onAction="onAction" />
              <button id="CurrentRegionButton" label="CurrentRegion.Select(&amp;C)" supertip="アクティブセル領域(データ範囲)を選択します。"  imageMso="SelectCurrentRegion" onAction="onAction" />
              <button id="EndDownButton" label="RangeSelection.End(xlDown).Select(&amp;E)" supertip="アクティブセル領域の下の行のセルを選択します。&#13;既にアクティブセル領域の下の行の場合は次のアクティブセル領域の上の行のセルを選択します。" onAction="onAction" />
              <button id="EntireColumnSelectButton" label="EntireColumn(&amp;C)" supertip="選択しているセルの列を選択します。" onAction="onAction" />
              <button id="EntireRowSelectButton" label="EntireRow(&amp;R)" supertip="選択しているセルの行を選択します。" onAction="onAction" />
              <button id="FormulaButton" label="Formula(&amp;F)" supertip="アクティブセルの式を表示します。" onAction="onAction" />
              <button id="HasFormulaButton" label="HasFormula(&amp;F)" supertip="アクティブセルが式かを表示します。" onAction="onAction" />
              <button id="HorizontalAlignmentCenterButton" label="HorizontalAlignment = xlCenter(&amp;H)" supertip="アクティブセルの水平方向の配置を中央に設定します。"  imageMso="AlignCenter" onAction="onAction" />
              <button id="InteriorColorIndexButton" label="Interior.ColorIndex(&amp;I)" supertip="アクティブセルの背景の色の番号を表示します。" onAction="onAction" />
              <button id="LockedButton" label="Locked(&amp;L)" supertip="アクティブセルがロックかを表示します。"  imageMso="Lock" onAction="onAction" />
              <button id="NumberFormatLocalButton" label="NumberFormatLocal(&amp;N)" supertip="アクティブセルの書式を表示します。"  imageMso="FormatCellsDialog" onAction="onAction" />
              <button id="OffsetButton" label="Offset(&amp;O)" supertip="中間シートの成績表先頭行以外を選択します。"  imageMso="ShowGridlines_HideGridlines" onAction="onAction" />
              <button id="SelectCellsCountButton" label="RangeSelection.Cells.Count(&amp;R)" supertip="選択したセルの数を表示します。" onAction="onAction" />
              <button id="RowsCountButton" label="Rows.Count(&amp;R)" supertip="選択範囲の行の数を表示します。" onAction="onAction" />
              <button id="TextButton" label="Text(&amp;T)" supertip="アクティブセルの書式付のテキストを表示します。"  imageMso="TextStylesGallery" onAction="onAction" />
              <button id="ValueButton" label="Value(&amp;V)" supertip="アクティブセルの値を表示します。" onAction="onAction" />
              <button id="UsedRangeAddressButton" label="UsedRange.Address(&amp;U)" supertip="アクティブシートの使用したセルのアドレスを表示します。"  imageMso="DollarSign" onAction="onAction" />
              <button id="WrapTextButton" label="WrapText(&amp;W)" supertip="アクティブセルは折り返して全体を表示するかを表示します。"  imageMso="WrapText" onAction="onAction" />
              <button id="ShrinkToFitButton" label="ShrinkToFit(&amp;S)" supertip="アクティブセルを縮小して全体を表示する・しないを切り換えます。" onAction="onAction" />
            </menu>
 <!-- ■■■ メソッド -->
            <menu id="MethodMenu" label="メソッド(&amp;M)" itemSize="normal" imageMso="HappyFace" size="normal" keytip="M">
              <button id="CopyButton" label="Copy(&amp;C)" supertip="選択したセルをコピーします。"  imageMso="Copy" onAction="onAction" />
              <button id="CutButton" label="Cut(&amp;X)" supertip="選択したセルを切り取りします。"  imageMso="Cut" onAction="onAction" />
              <button id="InsertButton" label="Insert(&amp;I)" supertip="セルを挿入します。" onAction="onAction" />
              <button id="DeleteButton" label="Delete(&amp;D)" supertip="選択したセルを削除します。" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator1" />
              <button id="ClearButton" label="Clear(&amp;C)" supertip="アクティブセルをクリアーします。"  imageMso="ClearAll" onAction="onAction" />
              <button id="ClearCommentsButton" label="ClearComments(&amp;C)" supertip="アクティブセルのコメントを削除します。"  imageMso="ReviewDeleteComment" onAction="onAction" />
              <button id="ClearContentsButton" label="ClearContents(&amp;C)" supertip="アクティブセルの値をクリアーします。" onAction="onAction" />
              <button id="ClearFormatsButton" label="ClearFormats(&amp;F)" supertip="アクティブセルの書式をクリアーします。"  imageMso="ClearFormats" onAction="onAction" />
              <button id="ClearHyperlinksButton" label="ClearHyperlinks(&amp;H)" supertip="アクティブセルのハイパーリンクをクリアーします。"  imageMso="HyperlinkRemove" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator2" />
              <button id="MergeButton" label="Merge(&amp;M)" supertip="選択した複数のセルを結合します。"  imageMso="MergeCells" onAction="onAction" />
              <button id="UnMergeButton" label="UnMerge(&amp;U)" supertip="アクティブセルの結合を解除します。"  imageMso="UnmergeCells" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator3" />
              <button id="FindButton" label="「?」を検索 Find(&amp;F)" supertip="「?」のあるセルの数を表示します。" onAction="onAction" />
              <button id="ReplaceButton" label="Replace(&amp;R)" supertip="「その他」シートの文字列の「Renge」と「RangeSelection」を置き換えます。"  imageMso="ReplaceDialog" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator4" />
              <button id="AddCommentButton" label="AddComment(&amp;C)" supertip="アクティブセルにコメントを追加します。"  imageMso="ReviewNewComment" onAction="onAction" />
              <button id="NoteTextButton" label="NoteText(&amp;N)" supertip="アクティブセルのコメントを変更します。"  imageMso="ReviewInkCommentNew" onAction="onAction" />
              <menuSeparator id="MethodMenuSeparator5" />
              <button id="AutoFitButton" label="EntireColumn.AutoFit(&amp;A)" supertip="列の幅を自動調整します。" onAction="onAction" />
              <button id="ShowButton" label="Show(&amp;S)" supertip="A1のアドレスのセルを表示します。(選択は変更しません)" onAction="onAction" />
              <button id="ShowErrorsButton" label="ShowErrors(&amp;E)" supertip="選択したセルの式のエラーを表示します。"  imageMso="CancelRequest" onAction="onAction" />
            </menu>
          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

このページの上

RangeModule
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン
Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理l
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  Dim s As String

  If Application.ActiveCell Is Nothing Then Exit Sub
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
'---< プロパティ >--------------------------------------------------------------------------------------------------------
    Case "AllowEditButton"
      MsgBox Prompt:="AllowEdit = " & ActiveWindow.RangeSelection.AllowEdit, Buttons:=vbInformation, Title:="RangeSelection.AllowEdit"
    Case "AreasCountButton"
      MsgBox Prompt:=ActiveWindow.RangeSelection.Areas.Count, Buttons:=vbInformation, Title:="RangeSelection.Areas.Count"
    Case "BordersButton"
      With ActiveWindow.RangeSelection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
      End With
    Case "ColumnsCountButton"
      MsgBox Prompt:="Columns.Count = " & ActiveWindow.RangeSelection.Columns.CountLarge, Buttons:=vbInformation, Title:="Columns.CountLarge"
    Case "CurrentRegionButton"
      ActiveCell.CurrentRegion.Select
    Case "EndDownButton"
      ActiveWindow.RangeSelection.End(xlDown).Select
    Case "EntireColumnSelectButton"
      ActiveWindow.RangeSelection.EntireColumn.Select
    Case "EntireRowSelectButton"
      ActiveWindow.RangeSelection.EntireRow.Select
    Case "FormulaButton"
      If ActiveCell.HasFormula Then MsgBox Prompt:="Formula " & ActiveCell.Formula, Buttons:=vbInformation, Title:="ActiveCell.Formula"
    Case "HasFormulaButton"
      MsgBox Prompt:="HasFormula = " & ActiveCell.HasFormula, Buttons:=vbInformation, Title:="ActiveCell.HasFormula"
    Case "HorizontalAlignmentCenterButton"
      ActiveCell.HorizontalAlignment = xlCenter
    Case "InteriorColorIndexButton"
      MsgBox Prompt:="Interior.ColorIndex = " & ActiveCell.Interior.ColorIndex, Buttons:=vbInformation, Title:="Interior.ColorIndex"
    Case "LockedButton"
      MsgBox Prompt:="Locked = " & ActiveCell.Locked, Buttons:=vbInformation, Title:="ActiveCell.Locked"
    Case "NumberFormatLocalButton"
      MsgBox Prompt:="NumberFormatLocal = " & ActiveCell.NumberFormatLocal, Buttons:=vbInformation, Title:="ActiveCell.NumberFormatLocal"
    Case "OffsetButton"
      Worksheets("中間").Select
      Worksheets("中間").Range("A2").CurrentRegion.Offset(1).Select
      ActiveWindow.RangeSelection.Resize(ActiveWindow.RangeSelection.Rows.CountLarge - 1).Select
    Case "RowsCountButton"
      MsgBox Prompt:="Rows.Count = " & ActiveWindow.RangeSelection.Rows.CountLarge, Buttons:=vbInformation, Title:="Rows.CountLarge"
    Case "TextButton"
      MsgBox Prompt:="ActiveCell.Text = " & ActiveCell.Text, Buttons:=vbInformation, Title:="ActiveCell.Text"
    Case "ValueButton"
      MsgBox Prompt:="ActiveCell.Value = " & ActiveCell.Value, Buttons:=vbInformation, Title:="ActiveCell.Value"
    Case "SelectCellsCountButton"
      MsgBox Prompt:="RangeSelection.Cells.Count = " & ActiveWindow.RangeSelection.Cells.CountLarge, Buttons:=vbInformation, Title:="RangeSelection.Cells.Count"
    Case "UsedRangeAddressButton"
      MsgBox Prompt:=ActiveSheet.UsedRange.Address, Buttons:=vbInformation, Title:="UsedRange.Address"
    Case "WrapTextButton"
      MsgBox Prompt:="WrapText = " & ActiveCell.WrapText, Buttons:=vbInformation, Title:="ActiveCell.WrapText"
    Case "ShrinkToFitButton"
      ActiveCell.ShrinkToFit = Not ActiveCell.ShrinkToFit
'---< メソッド >--------------------------------------------------------------------------------------------------------
    Case "AutoFitButton"
      ActiveWindow.RangeSelection.EntireColumn.AutoFit
    Case "AddCommentButton"
      ActiveCell.AddComment (Format(Now(), "yyyy/mm/dd hh:mm:ss"))
    Case "ClearButton"
      ActiveWindow.RangeSelection.Clear
    Case "ClearCommentsButton"
      ActiveWindow.RangeSelection.ClearComments
    Case "ClearContentsButton"
      ActiveWindow.RangeSelection.ClearContents
    Case "ClearFormatsButton"
      ActiveWindow.RangeSelection.ClearFormats
    Case "ClearHyperlinksButton"
      ActiveWindow.RangeSelection.ClearHyperlinks
    Case "CopyButton"
      ActiveWindow.RangeSelection.Copy
    Case "CutButton"
      ActiveWindow.RangeSelection.Cut
    Case "DeleteButton"
      ActiveWindow.RangeSelection.Delete xlShiftUp ' xlShiftToLeftは左にづれます。
    Case "FindButton"
      Call FindQuestion
    Case "InsertButton"
      ActiveWindow.RangeSelection.Insert xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' xlShiftToRightは右にづれます。
    Case "MergeButton"
      ActiveWindow.RangeSelection.Merge
    Case "NoteTextButton"
      If Not ActiveCell.Comment Is Nothing Then ActiveCell.NoteText Text:=Format(Now(), "yyyy年mm月dd日 hh時mm分ss秒 コメントを変更しました。")
    Case "ReplaceButton"
      Worksheets("その他").Select
      Worksheets("その他").UsedRange.Select
      ActiveWindow.RangeSelection.Replace What:="Range", Replacement:="RangeSelection"
      MsgBox Prompt:="「Renge」を「RangeSelection」に置き換えました。" & vbCrLf & vbCrLf & "文字列を元に置き換えます。", Buttons:=vbInformation, Title:="Replace"
      ActiveWindow.RangeSelection.Replace What:="RangeSelection", Replacement:="Range"
    Case "ShowButton"
      Range("A50").Select
      MsgBox Prompt:="A1のアドレスのセルを表示します。(選択は変更しません)", Buttons:=vbInformation, Title:="Show"
      Range("A1").Show
    Case "ShowErrorsButton"
      ActiveWindow.RangeSelection.ShowErrors
    Case "UnMergeButton"
      If ActiveCell.MergeCells Then ActiveCell.MergeArea.UnMerge
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical, Title:="エラー"
  End Select
  Exit Sub

ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical, Title:="エラー"
End Sub
' 「?」のあるセルの数を表示します。
Sub FindQuestion()
  Dim FindCell As Range
  Dim FirstAddress As String
  Dim cnt As Long

  cnt = 0
  Worksheets("その他").Select
  With Worksheets("その他").UsedRange
    Set FindCell = .Find("~?", LookIn:=xlValues) ' 「?」はメタキャラなので検索するには、チルダ(~)を前に「~?」付けます。
    If Not FindCell Is Nothing Then              ' 「*」を検索するには「~*」
      FirstAddress = FindCell.Address            ' 「~」を検索するには「~~」
      Do
        Set FindCell = .FindNext(FindCell)
        cnt = cnt + 1
      Loop While Not FindCell Is Nothing And FindCell.Address <> FirstAddress
    End If
  End With
  MsgBox Prompt:="「?」のあるセルの数は " & cnt & " です。", Buttons:=vbInformation, Title:="「?」の検索"
End Sub

このページの上