目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
248 / 262 ←次へ | 前へ→

【15】各種マクロ
Excel  ぴかる  - 02/9/2(月) 21:21 -

引用なし
パスワード
   Sub 表示形式()
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogFormatNumber).Show
  End If

End Sub
Sub 配置()
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogAlignment).Show
  End If

End Sub
Sub フォント()

  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogFont).Show
  End If

End Sub
Sub 罫線()
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogBorder).Show
  End If
  
End Sub
Sub パターン()
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogPatterns).Show
  End If

End Sub
Sub 保護()
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   Application.Dialogs(xlDialogCellProtection).Show
  End If

End Sub
Sub シート保護()

  If ActiveSheet.ProtectContents Then
   ActiveSheet.Unprotect
  Else
   ActiveSheet.Protect
  End If

End Sub
Sub シート選択()

  CommandBars("WorkBook tabs").ShowPopup

End Sub
Sub シート見出し()
  
  If ActiveWindow.DisplayWorkbookTabs = False Then
   ActiveWindow.DisplayWorkbookTabs = True
  ElseIf ActiveWindow.DisplayWorkbookTabs = True Then
   ActiveWindow.DisplayWorkbookTabs = False
  End If
  
End Sub
Sub 全てクリア()
 
If ActiveSheet.ProtectContents Then
Else
 
  Selection.Clear

  Dim Sh As Shape, R1 As Range, R2 As Range
  If TypeName(Selection) = "Range" Then
   If ActiveSheet.Shapes.Count > 0 Then
     For Each Sh In ActiveSheet.Shapes
      '図形が完全に範囲に含まれる場合は削除する
      '図形左上セルのチェック
      Set R1 = Application.Intersect(Selection, _
                      Sh.TopLeftCell)
      '図形右下セルのチェック
      Set R2 = Application.Intersect(Selection, _
                      Sh.BottomRightCell)
      If R1 Is Nothing Or R2 Is Nothing Then
       '左上セルまたは右下セルが選択範囲の外にある場合は無視
        '両方外にある場合も無視
      Else
       Sh.Delete
      End If
     Next
   End If
  End If
 
  Set R1 = Nothing: Set R2 = Nothing
  
 End If

End Sub
Sub 書式と値の貼り付け()
 
  On Error GoTo errout
  With Selection
   .PasteSpecial Paste:=xlPasteValues
   .PasteSpecial Paste:=xlPasteFormats
  End With
finish:
  Exit Sub
errout:
  MsgBox Error(Err.Number), vbCritical
  Resume finish

End Sub
Sub 列Caption()
  
  Set myCBCtrl = Application.CommandBars("PikaBar").Controls("セル書式").Controls(8)
  If Application.ReferenceStyle = xlR1C1 Then
   myCBCtrl.Caption = "列表示…A1形式"
  ElseIf Application.ReferenceStyle = xlA1 Then
   myCBCtrl.Caption = "列表示…R1C1形式"
  End If
  
  'CommandBars.AdaptiveMenus = False 'これを有効にすると全て表示となるけど2回押さないとダメみたい
                    '2000以上有効
End Sub
Sub 列表示切替()
  
  If Application.ReferenceStyle = xlR1C1 Then
   Application.ReferenceStyle = xlA1
  ElseIf Application.ReferenceStyle = xlA1 Then
   Application.ReferenceStyle = xlR1C1
  End If

End Sub
Sub エラーメッセージ()
  
   MsgBox "実行できましぇん!。" & vbLf & _
      "(セル以外を選択? シート保護中?)"

End Sub

5,705 hits

【4】アドインファイルにてツールバーを表示するには、[ソフト紹介] ぴかる 02/9/2(月) 20:42 Excel[未読]
【5】マクロ構成とセット方法 ぴかる 02/9/2(月) 20:54 Excel[未読]
【6】ThisWorkbook ぴかる 02/9/2(月) 20:56 Excel[未読]
【7】標準モジュール ぴかる 02/9/2(月) 21:02 Excel[未読]
【8】セッティング ぴかる 02/9/2(月) 21:03 Excel[未読]
【9】ツールバー ぴかる 02/9/2(月) 21:06 Excel[未読]
【10】つづき ぴかる 02/9/2(月) 21:07 Excel[未読]
【11】パレート図 ぴかる 02/9/2(月) 21:08 Excel[未読]
【12】メイン ぴかる 02/9/2(月) 21:15 Excel[未読]
【13】メニューバー ぴかる 02/9/2(月) 21:19 Excel[未読]
【14】つづき ぴかる 02/9/2(月) 21:20 Excel[未読]
【15】各種マクロ ぴかる 02/9/2(月) 21:21 Excel[未読]
【16】小ワザ集 ぴかる 02/9/2(月) 21:23 Excel[未読]
【17】つづき ぴかる 02/9/2(月) 21:25 Excel[未読]
【18】つづきのつづき ぴかる 02/9/2(月) 21:25 Excel[未読]
【19】小ワザ集97 ぴかる 02/9/2(月) 21:27 Excel[未読]
【20】つづき ぴかる 02/9/2(月) 21:27 Excel[未読]
【21】つづきのつづき ぴかる 02/9/2(月) 21:28 Excel[未読]
【22】入力設定 ぴかる 02/9/2(月) 21:29 Excel[未読]
【25】文字変換 ぴかる 02/9/2(月) 21:32 Excel[未読]
【26】Class1 ぴかる 02/9/3(火) 7:57 Excel[未読]
【27】最後に ぴかる 02/9/3(火) 12:52 Excel[未読]

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
248 / 262 ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free