管理人の覚書 <
拡張機能.bas
をテンプレートにして作成>
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
]
開始行:
#norelated
#contents
----
**RC切替 [#b6726b7b]
Sub RC切替_tools(control As IRibbonControl)
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
Else
Application.ReferenceStyle = xlA1
End If
End Sub
**Win最大 [#a423942e]
Sub Win最大_tools(control As IRibbonControl)
Application.WindowState = xlNormal
Application.Left = 1
Application.Top = 1
Application.Width = 1920
Application.Height = 745
End Sub
**フィルタ解除 [#i62d3b76]
Sub フィルタ解除_tools(control As IRibbonControl)
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
End Sub
**結合解除 [#p9ff8c43]
Sub 結合解除_tools(control As IRibbonControl)
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For y = 開始Y To 終了Y
For x = 開始X To 終了X
Set セル = ActiveSheet.Cells(y, x)
カウントX = セル.MergeArea.Columns.Count
カウントY = セル.MergeArea.Rows.Count
If カウントX > 1 Or カウントY > 1 Then
セル.UnMerge
For yy = 0 To カウントY - 1
For XX = 0 To カウントX - 1
セル.Offset(yy, XX) = セル
Next
Next
End If
Next
Next
End Sub
**自動計算停止 [#ac75222b]
Sub 自動計算停止_tools(control As IRibbonControl)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
**指定範囲再計算 [#s8dbab48]
Sub 指定範囲再計算_tools(control As IRibbonControl)
Selection.Calculate
End Sub
**格子に並べて表示 [#ebfc0574]
Sub 格子に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleTiled
End Sub
**横に並べて表示 [#zbd3af6b]
Sub 横に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleVertical
End Sub
**縦に並べて表示 [#ke5fa83a]
Sub 縦に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleHorizontal
End Sub
**範囲で中央 [#pf01090c]
Sub 範囲で中央_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
Range(Cells(開始Y, 開始X), Cells(終了Y, 終了X)).Hori...
End Sub
**半角2全角 [#vdbd9259]
Sub 半角2全角_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbWide)
Next
End Sub
**全角2半角 [#xdea6fef]
Sub 全角2半角_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbNarrow)
Next
End Sub
**空白削除 [#o1607f1d]
Sub 空白削除_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = Trim(cellval)
Next
End Sub
**大文字変換 [#v22dc2ea]
Sub 大文字変換_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbUpperCase)
Next
End Sub
**小文字変換 [#m8541c80]
Sub 小文字変換_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbLowerCase)
Next
End Sub
**セル2コメント [#z4936118]
Sub セル2コメント_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For x = 開始X To 終了X
For y = 開始Y To 終了Y
If Cells(y, x) = "" Then
Else
Cells(y, x).ClearComments
Cells(y, x).AddComment CStr(Cells(y, x))
Cells(y, x) = ""
End If
Next
Next
End Sub
**コメント2セル [#y0006315]
Sub コメント2セル_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For x = 開始X To 終了X
For y = 開始Y To 終了Y
If Cells(y, x).Comment Is Nothing Then
Else
Cells(y, x) = Cells(y, x).Comment.Text
Cells(y, x).ClearComments
End If
Next
Next
End Sub
**UNIQ [#s226bb08]
Sub UNIQ_tools(control As IRibbonControl)
Dim CB As New DataObject
Set objNamedArrayKey = CreateObject("Scripting.Dicti...
For i = 1 To Selection.Count
データ = Trim(Selection(i))
If データ <> "" And objNamedArrayKey.exists(デー...
objNamedArrayKey.Add データ, データ
結果 = 結果 & データ & vbLf
End If
Next
CB.SetText Trim(結果)
CB.PutInClipboard
End Sub
**スタイル削除 [#p56fe07e]
Sub スタイル削除_tools(control As IRibbonControl)
On Error Resume Next
Set WB = Workbooks(ActiveWorkbook.Name)
For Each ST In WB.Styles
If InStr("Normal,Followed Hyperlink,Percent,Comm...
Debug.Print ST.Name
WB.Styles(ST.Name).Delete
End If
Next
End Sub
**名前定義削除 [#p63b69de]
Sub 名前定義削除_tools(control As IRibbonControl)
On Error Resume Next
Set WB = Workbooks(ActiveWorkbook.Name)
For Each 名前 In WB.Names
Debug.Print 名前.Name
WB.Names(名前.Name).Delete
Next
End Sub
**日付変換 [#h42e5d10]
Sub 日付変換_tools(control As IRibbonControl)
For Each cellval In Selection
If IsDate(cellval.Value) Then
cellval.Value = "'" & cellval
End If
Next
End Sub
**フィルタ [#c268eb63]
Sub フィルタ_tools(control As IRibbonControl)
On Error Resume Next
Dim CB As New DataObject
行 = ActiveCell.Row
列 = ActiveCell.Column
範囲 = Selection.Count
If 範囲 > 1 Then
CB.GetFromClipboard
キー = Trim(Replace(CB.GetText, vbCrLf, ""))
Else
キー = Cells(行, 列)
End If
Selection.AutoFilter field:=列, Criteria1:="*" & キ...
End Sub
終了行:
#norelated
#contents
----
**RC切替 [#b6726b7b]
Sub RC切替_tools(control As IRibbonControl)
If Application.ReferenceStyle = xlA1 Then
Application.ReferenceStyle = xlR1C1
Else
Application.ReferenceStyle = xlA1
End If
End Sub
**Win最大 [#a423942e]
Sub Win最大_tools(control As IRibbonControl)
Application.WindowState = xlNormal
Application.Left = 1
Application.Top = 1
Application.Width = 1920
Application.Height = 745
End Sub
**フィルタ解除 [#i62d3b76]
Sub フィルタ解除_tools(control As IRibbonControl)
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
End Sub
**結合解除 [#p9ff8c43]
Sub 結合解除_tools(control As IRibbonControl)
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For y = 開始Y To 終了Y
For x = 開始X To 終了X
Set セル = ActiveSheet.Cells(y, x)
カウントX = セル.MergeArea.Columns.Count
カウントY = セル.MergeArea.Rows.Count
If カウントX > 1 Or カウントY > 1 Then
セル.UnMerge
For yy = 0 To カウントY - 1
For XX = 0 To カウントX - 1
セル.Offset(yy, XX) = セル
Next
Next
End If
Next
Next
End Sub
**自動計算停止 [#ac75222b]
Sub 自動計算停止_tools(control As IRibbonControl)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
**指定範囲再計算 [#s8dbab48]
Sub 指定範囲再計算_tools(control As IRibbonControl)
Selection.Calculate
End Sub
**格子に並べて表示 [#ebfc0574]
Sub 格子に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleTiled
End Sub
**横に並べて表示 [#zbd3af6b]
Sub 横に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleVertical
End Sub
**縦に並べて表示 [#ke5fa83a]
Sub 縦に並べて表示_tools(control As IRibbonControl)
Windows.Arrange xlArrangeStyleHorizontal
End Sub
**範囲で中央 [#pf01090c]
Sub 範囲で中央_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
Range(Cells(開始Y, 開始X), Cells(終了Y, 終了X)).Hori...
End Sub
**半角2全角 [#vdbd9259]
Sub 半角2全角_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbWide)
Next
End Sub
**全角2半角 [#xdea6fef]
Sub 全角2半角_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbNarrow)
Next
End Sub
**空白削除 [#o1607f1d]
Sub 空白削除_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = Trim(cellval)
Next
End Sub
**大文字変換 [#v22dc2ea]
Sub 大文字変換_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbUpperCase)
Next
End Sub
**小文字変換 [#m8541c80]
Sub 小文字変換_tools(control As IRibbonControl)
For Each cellval In Selection
cellval.Value = StrConv(cellval, vbLowerCase)
Next
End Sub
**セル2コメント [#z4936118]
Sub セル2コメント_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For x = 開始X To 終了X
For y = 開始Y To 終了Y
If Cells(y, x) = "" Then
Else
Cells(y, x).ClearComments
Cells(y, x).AddComment CStr(Cells(y, x))
Cells(y, x) = ""
End If
Next
Next
End Sub
**コメント2セル [#y0006315]
Sub コメント2セル_tools(control As IRibbonControl)
開始Y = Selection(1).Row
開始X = Selection(1).Column
終了Y = Selection(Selection.Count).Row
終了X = Selection(Selection.Count).Column
For x = 開始X To 終了X
For y = 開始Y To 終了Y
If Cells(y, x).Comment Is Nothing Then
Else
Cells(y, x) = Cells(y, x).Comment.Text
Cells(y, x).ClearComments
End If
Next
Next
End Sub
**UNIQ [#s226bb08]
Sub UNIQ_tools(control As IRibbonControl)
Dim CB As New DataObject
Set objNamedArrayKey = CreateObject("Scripting.Dicti...
For i = 1 To Selection.Count
データ = Trim(Selection(i))
If データ <> "" And objNamedArrayKey.exists(デー...
objNamedArrayKey.Add データ, データ
結果 = 結果 & データ & vbLf
End If
Next
CB.SetText Trim(結果)
CB.PutInClipboard
End Sub
**スタイル削除 [#p56fe07e]
Sub スタイル削除_tools(control As IRibbonControl)
On Error Resume Next
Set WB = Workbooks(ActiveWorkbook.Name)
For Each ST In WB.Styles
If InStr("Normal,Followed Hyperlink,Percent,Comm...
Debug.Print ST.Name
WB.Styles(ST.Name).Delete
End If
Next
End Sub
**名前定義削除 [#p63b69de]
Sub 名前定義削除_tools(control As IRibbonControl)
On Error Resume Next
Set WB = Workbooks(ActiveWorkbook.Name)
For Each 名前 In WB.Names
Debug.Print 名前.Name
WB.Names(名前.Name).Delete
Next
End Sub
**日付変換 [#h42e5d10]
Sub 日付変換_tools(control As IRibbonControl)
For Each cellval In Selection
If IsDate(cellval.Value) Then
cellval.Value = "'" & cellval
End If
Next
End Sub
**フィルタ [#c268eb63]
Sub フィルタ_tools(control As IRibbonControl)
On Error Resume Next
Dim CB As New DataObject
行 = ActiveCell.Row
列 = ActiveCell.Column
範囲 = Selection.Count
If 範囲 > 1 Then
CB.GetFromClipboard
キー = Trim(Replace(CB.GetText, vbCrLf, ""))
Else
キー = Cells(行, 列)
End If
Selection.AutoFilter field:=列, Criteria1:="*" & キ...
End Sub
ページ名:
