目安箱 IV

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

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

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

【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[未読]

【4】アドインファイルにてツールバーを表示するに...
Excel  ぴかる  - 02/9/2(月) 20:42 -

引用なし
パスワード
    自作ツールバーアドインソフトが完成致しましたので、こちらにて紹介させて頂きます。このソフトは、エクセルの作業効率向上を目的として作成致しました。通常のツールバーに便利アイコンを多数追加しております。このアイコンは、ユーザー設定からの抜粋とオリジナルマクロ(みなさまから多数ご支援)にて構成されています。また、このソフトはアドインにて作動するものです。ご支援をくださった皆様方には、この場をお借りして厚く御礼申し上げます。誠にありがとうございました。
 
ソフト概要
 通常表示されているメニューバー、標準・書式設定・図形描画ツールバー等を非表示としてオリジナルツールバーと置き換えて作動するソフトです。(現在、お使いのバーと新バーとの入れ替えです。)

  ※ エクセル2000をベースとして作成しています。97でもテスト済み。2002でも可?

免責
 いかなる不具合が発生しても責任を負うことができません。ご了承下さい。

追加分紹介 (★印はマクロです。 ()は、ご支援頂いた方のお名前です。)
 ◎オリジナル標準
  ・名前を付けて保存(りんさん)
  ・印刷(ダイアログBOX表示に変更)
  ・印刷範囲の設定
  ・ページ設定
  ・★すべてクリア(りんさん過去ログを頂きました)
  ・書式の貼り付け
  ・値の貼り付け
  ・★書式と値の貼り付け(りんさん)
  ・カメラ
  ・セルの挿入
  ・セルの削除
  ・参照元のトレース
  ・参照元トレース矢印の削除
  ・すべてのトレース矢印の削除
  ・★パレート図の自動作成(ミコさん…他サイト)
  ・マクロボタン
  ・マクロの実行
  ・マクロの記録
  ・Visual Basic Editor

 ◎オリジナル書式設定
  ・フォントサイズの拡大
  ・フォントサイズの縮小
  ・縦書きテキスト
  ・★縦方向下詰め(なおちーさん…他サイト)
  ・★縦方向中央揃え(なおちーさん…他サイト)
  ・★縦方向上詰め(なおちーさん…他サイト)
  ・横方向に結合
  ・セル結合の解除
  ・ウィンドウ枠の固定
  ・ウィンドウの整列
  ・行の高さ
  ・列の幅
  ・罫線のクリア
  ・罫線…外枠
  ・罫線…格子
  ・★罫線…ダイアログBOX
  ・パターン
  ・電卓

 ◎オリジナル図形描画
  ・検索
  ・置換
  ・ワークシートの挿入
  ・シートの移動またはコピー
  ・★シートの保護・保護解除
  ・★シート見出しの表示・非表示
  ・★シート選択表示(JuJuさん)
  ・オプション
  ・図形のグループ化
  ・図形のグループ解除
  ・図形の再グループ化
  ・グリッドに合わせる
  ・図形に合わせる
  ・最前面へ移動
  ・最背面へ移動
  ・フリーハンド

  ◎オリジナルメニューバー
  ・★セル書式
    書式各項目、条件付き書式、列表示切替を行います。
  ・★入力設定(りんさん、JuJuさん)
    入力範囲設定、日本語入力設定、移動方向設定を行います。
  ・★文字変換
    全角、半角、大文字、小文字に変換します。
  ・★小ワザ集
    一般操作のちょっとしたテクニック集です。
  ・★元に戻す
    ツールバーを元に戻します。

  ◎右クリック(セル)
  ・書式の貼り付け
  ・値の貼り付け
  ・★書式と値の貼り付け(りんさん)
  ・★すべてクリア(りんさん過去ログ)

【5】マクロ構成とセット方法
Excel  ぴかる  - 02/9/2(月) 20:54 -

引用なし
パスワード
   マクロ構成
  マクロは、[ThisWorkbook、標準モジュール(10)、クラスモジュール(1)]にて構成 されて
  います。

作成方法
  1.新規BOOKを作成して下さい。(他のBOOKは無しの事)
  2.標準モジュールを10ヶ、クラスモジュールを1ヶ作成して下さい。
  3.別置きのマクロをコピーして下さい。
  4.エクセルを閉じて下さい。
     自動でデスクトップ上に[PikaTool]フォルダ作成され、その中に[ピカせっと.xls]が
     作成されます。
  5.ピカせっとを開く
     自動でアドイン[ピカつーる]が作成され、オリジナルツールバーに置き換えます。
     気に入られなかった方の為にメニューバーに[元に戻す]を設置しています。

 ※Win95、一部のNTでは、[ピカせっと.xls]を作成出来ません。
   但し、作成された[ピカせっと.xls]を開く事は出来ます。

元に戻すには
  メニューバー右の元に戻すにて元のツールバーに戻ります。
  再び、「ピカつーる」にしたい場合はツール→アドインにてチェックを入れて下さい。
  ファイルも削除したい場合は、「ピカつーる.xla」で検索・削除して下さい。

現在の問題点
 ・セル書式にて全項目が表示されない。(2000以上)
   下記マクロを行うとOKとなるが、2回押さないといけない。
    CommandBars.AdaptiveMenus = False
 ・97にてバルーン横幅の調整が効かない。
   縦長で黒字となってしまいます。
 ・縦方向の配置アイコンが動作出来ないPCが有る。
   社内で試した結果、1台動作しないPCが有りました。
   エクセルのインストールのやり方の違いかもしれません。
 ・アイコンの追加
   ピカつーるのツールバーには、ユーザー設定等でのアイコン追加は出来ません。
   追加されたい場合は、最上段のメニューバー右の空白部に設置して下さい。

【6】ThisWorkbook
Excel  ぴかる  - 02/9/2(月) 20:56 -

引用なし
パスワード
   Private Sub Workbook_AddinInstall()

  オリジナルツールバー作成

End Sub
Private Sub Workbook_AddinUninstall()

  ツールバーを元に戻す

End Sub

【7】標準モジュール
Excel  ぴかる  - 02/9/2(月) 21:02 -

引用なし
パスワード
   次の10ヶの標準モジュールにて構成されています。

・セッティング
・ツールバー
・パレート図
・メイン
・メニューバー
・各種マクロ
・小ワザ集
・小ワザ集97
・入力設定
・文字変換

【8】セッティング
Excel  ぴかる  - 02/9/2(月) 21:03 -

引用なし
パスワード
   Sub ピカせっと作成()

Dim パス名 As String

   MsgBox "デスクトップ上に[PikaTool]フォルダを作成するよ!" & vbLf & "" & vbLf & _
      "処理が終わったらフォルダ内の[ピカせっと.xls]を開いてちょ!!" & vbLf & _
      "そしたら、自動で[ピカつーる]がセットされるよ。" _
      , vbInformation, " 【 さぁ、つくるよ〜ん! 】"
  
  フラグ = 1
  パス名 = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\PikaTool"
  
  'デスクトップにフォルダ作成
  If (Dir(パス名, vbDirectory) = "") Then
  
   On Error Resume Next
    MkDir パス名
   If Err = 75 Then
   MsgBox "デスクトップ上に[PikaTool]フォルダを作れないみたい!" _
       , vbInformation, " 【 ダメでした! 】"
     On Error GoTo 0
     Exit Sub
   End If
  End If
 
  On Error GoTo 0
 
  'パスワード登録する。
  With Application
   .Visible = False
   
   With .VBE.Windows(1)
     .SetFocus
     SendKeys "%TE^{TAB} {TAB}" & "PIKARU" & "{TAB}" & "PIKARU" & "{TAB}{ENTER}", True
   End With
   .VBE.MainWindow.Visible = False
   .Visible = True
  Sheets("Sheet1").Select
   .Visible = False
  End With
  With Range("A1:Z60").Interior
    .ColorIndex = 8
    .Pattern = xlGrid
    .PatternColorIndex = 2
  End With
  
  Range("C6:L8").Select
  Selection.Interior.ColorIndex = xlNone
  With Selection
    .Interior.ColorIndex = xlNone
    .Merge
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Name = "MS Pゴシック"
    .Font.FontStyle = "太字 斜体"
    .Font.Size = 20
    .Font.ColorIndex = 53
  End With
  
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlDashDotDot
    .Weight = xlMedium
    .ColorIndex = 5
  End With
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlDashDotDot
    .Weight = xlMedium
    .ColorIndex = 5
  End With
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDashDotDot
    .Weight = xlMedium
    .ColorIndex = 5
  End With
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlDashDotDot
    .Weight = xlMedium
    .ColorIndex = 5
  End With
  Selection.Borders(xlInsideVertical).LineStyle = xlNone
  Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
  
  Range("C6") = "!(^^)! ようこそ、ピカつーるセッティングへ  !(^^)!"
  With Range("C6")
   .Characters(Start:=1, Length:=6).Font.ColorIndex = 46
   .Characters(Start:=1, Length:=6).Font.FontStyle = "太字"
   .Characters(Start:=27, Length:=6).Font.ColorIndex = 46
   .Characters(Start:=27, Length:=6).Font.FontStyle = "太字"
  End With
  Rows("1:1").EntireRow.Hidden = True
  Range("A1").Select

  With ActiveWindow
    .DisplayGridlines = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
    .DisplayWorkbookTabs = False
    .DisplayHeadings = False
    .ScrollRow = 1
    .ScrollColumn = 1
  End With

  Application.DisplayAlerts = False '警告メッセージオフにする
  ActiveWorkbook.SaveAs Filename:=パス名 & "\ピカせっと.xls"

End Sub
Sub ピカつーる作成()

Dim パス名 As String
Dim タイトル As String
Dim スタイル As String
Dim メッセージ As String
Dim YESNO As String
  
On Error GoTo エラー処理

  ActiveWindow.WindowState = xlMaximized
  メッセージ = "あどいんソフト[ピカつーる]をセットするよ。いいかなぁ〜?"
  スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
  タイトル = " 【 ピカつーるセッティング 】"
  YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
  If YESNO = vbYes Then
  
  If Val(Application.Version) <> 8 Then
   パス名 = Application.UserLibraryPath
  Else
   パス名 = Application.LibraryPath & "\"
  End If
  If Dir(パス名, vbDirectory) = "" Then
   MsgBox "セットフォルダ[ " & パス名 & " ]がありましぇん。(>_<)", vbInformation, タイトル
   Exit Sub
  End If
  
  If (Dir(パス名 & "ピカつーる.xla") <> "") Then
   If (AddIns("ピカつーる").Installed = True) Then
    AddIns("ピカつーる").Installed = False
   End If
  End If
  
  Workbooks.Add
  With ThisWorkbook
    .IsAddin = True
    Application.DisplayAlerts = False '警告メッセージオフにする
    .SaveAs Filename:=パス名 & "ピカつーる.xla", FileFormat:=xlAddIn
  End With

  AddIns("ピカつーる").Installed = True
  Exit Sub

  Else
   MsgBox "キャンセルしたよ。", vbInformation, タイトル
   Exit Sub
  End If
 
エラー処理:
   MsgBox "ゴメン、できんかった。(;_;)", vbInformation, タイトル

End Sub

【9】ツールバー
Excel  ぴかる  - 02/9/2(月) 21:06 -

引用なし
パスワード
   Dim myCB As CommandBar
Dim myCB2 As CommandBar
Dim myCBCtrl As CommandBarControl
Dim myCBCtrl2 As CommandBarControl
Sub 既存ツールバーを非表示()

  On Error Resume Next    'エラーが発生しても処理を続行する
  
  For Each myCB In Application.CommandBars
    myCB.Visible = False
  Next myCB
  
  On Error GoTo 0       'エラー処理ルーチンを無効にする
  
  Application.CommandBars("Worksheet Menu Bar").Enabled = False
  
End Sub
Sub 右クリック部追加()

  For Each myCB In Application.CommandBars
   If myCB.Name = "Cell" Then myCB.Reset
  Next
 
  For Each myCB In Application.CommandBars
   If myCB.Name = "Cell" Then
     myCB.Reset
    
     Set myCBCtrl = myCB.Controls.Add(ID:=369, Before:=5)
     With myCBCtrl
      .Style = msoButtonIconAndCaption
      .BeginGroup = True
     End With
    
     Set myCBCtrl = myCB.Controls.Add(ID:=370, Before:=6)
     myCBCtrl.Style = msoButtonIconAndCaption
    
     Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton, Before:=7)
     With myCBCtrl
      .FaceId = 1606
      .Caption = "書式と値の貼り付け"
      .Style = msoButtonIconAndCaption
      .OnAction = "書式と値の貼り付け"
      .Enabled = False
     End With
   
     Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton, Before:=11)
     With myCBCtrl
      .FaceId = 1964
      .Caption = "すべてクリア(元に戻せません)"
      .Style = msoButtonIconAndCaption
      .OnAction = "全てクリア"
      .BeginGroup = True
     End With
   
   End If
  Next
 
End Sub
Sub オリジナル標準作成()

  On Error Resume Next
  Application.CommandBars("オリジナル標準").Delete
  
  Set myCB = Application.CommandBars.Add(Name:="オリジナル標準")
  
  With myCB
    .Controls.Add ID:=2520
    .Controls.Add ID:=23
    .Controls.Add ID:=3
  
   Set myCBCtrl = myCB.Controls.Add(ID:=748)
   With myCBCtrl
     .Style = msoButtonIcon
     .FaceId = 271
   End With
  
    .Controls.Add ID:=3738

   Set myCBCtrl = myCB.Controls.Add(ID:=4)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=364
  
   Set myCBCtrl = myCB.Controls.Add(ID:=247)
   With myCBCtrl
     .Style = msoButtonIcon
     .TooltipText = "《 ページ設定 》" & vbLf & _
            " [ ページ ]" & vbLf & _
            "  ○ 横(F)を選択すると自動縮小します。" & vbLf & _
            " [ ヘッダー・フッター ]" & vbLf & _
            "  用紙上・下にコメント、ページNo等を付けて印刷できます。" & vbLf & _
            " [ シート ]" & vbLf & _
            "  データベース印刷時等の印刷時にタイトルを指定すると" & vbLf & _
            "  全ての用紙に項目が入ります。"
   End With
  
    .Controls.Add ID:=109
    .Controls.Add ID:=2
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = " 《 すべてクリア 》" & vbLf & _
            "・数式、値、書式、図形の全てをクリアします。" & vbLf & _
            "・実行後は、元に戻せません。ご注意下さい。"
     .FaceId = 1964
     .OnAction = "全てクリア"
     .BeginGroup = True
   End With

    .Controls.Add ID:=21
    .Controls.Add ID:=19
    .Controls.Add ID:=22
    .Controls.Add ID:=369
    .Controls.Add ID:=370
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .FaceId = 1606
     .TooltipText = "書式と値の貼り付け"
     .Style = msoButtonIcon
     .OnAction = "書式と値の貼り付け"
   End With
   
   Set myCBCtrl = myCB.Controls.Add(ID:=280)
   myCBCtrl.TooltipText = " 《 カメラ 》" & vbLf & _
              "・セル内容を図形として貼り付け出来ます。" & vbLf & _
              "・思い通りの大きさに表を作成出来ない時等に最適です。" & vbLf & _
              "・元セルと図形は、リンクしています。" & vbLf & _
              "・図形の線の色にて線無しにする事をお勧めします。"
  
   Set myCBCtrl = myCB.Controls.Add(ID:=128)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=129
  
   Set myCBCtrl = myCB.Controls.Add(ID:=295)
   With myCBCtrl
     .BeginGroup = True
     .TooltipText = " 《 挿入 》" & vbLf & _
            "・セル、行、列を選択後、実行!"
   End With
  
   Set myCBCtrl = myCB.Controls.Add(ID:=292)
   With myCBCtrl
     .TooltipText = " 《 削除 》" & vbLf & _
            "・セル、行、列を選択後、実行!"
   End With
  
   Set myCBCtrl = myCB.Controls.Add(ID:=1576)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=226
    .Controls.Add ID:=385
    .Controls.Add ID:=210
    .Controls.Add ID:=211
    
   Set myCBCtrl = myCB.Controls.Add(ID:=486)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=452
    .Controls.Add ID:=453
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .FaceId = 433
     .OnAction = "パレート図作成"
     .BeginGroup = True
     .TooltipText = " 《 パレート図 》" & vbLf & _
            "・並び替え、比率計算を自動で行います。" & vbLf & _
            "・データの左上角にセレクトして実行して下さい。" & vbLf & _
            "・詳しい内容は、アイコンをクリックにて!!"
   End With

    .Controls.Add ID:=436
    .Controls.Add ID:=204
    
   Set myCBCtrl2 = Application.CommandBars.FindControl(ID:=1733)
   Set myCBCtrl = myCB.Controls.Add(ID:=1733) '既存のコマンド:ズーム
   myCBCtrl.Width = myCBCtrl2.Width '幅調整
   
    .Controls.Add ID:=984
    
   Set myCBCtrl = myCB.Controls.Add(ID:=282)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=186
    .Controls.Add ID:=184
    .Controls.Add ID:=1695
  
    .Visible = True
    .Position = msoBarTop
  
  End With

End Sub
Sub オリジナル書式設定作成()
  
  On Error Resume Next
  Application.CommandBars("オリジナル書式設定").Delete
  
  Set myCB = Application.CommandBars.Add(Name:="オリジナル書式設定")
  
  With myCB
    .Controls.Add ID:=1728
    
   Set myCBCtrl2 = Application.CommandBars.FindControl(ID:=1731)
   Set myCBCtrl = myCB.Controls.Add(ID:=1731) '既存のコマンド:ズーム
   myCBCtrl.Width = myCBCtrl2.Width '幅調整
   
    .Controls.Add ID:=403
    .Controls.Add ID:=404
    .Controls.Add ID:=113
    .Controls.Add ID:=114
    .Controls.Add ID:=115
    .Controls.Add ID:=405
  
   Set myCBCtrl = myCB.Controls.Add(ID:=120)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=122
    .Controls.Add ID:=121
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "下詰め"
     .FaceId = 2601
     .OnAction = "'mySetVerticalAlignment " & xlBottom & "'"
   End With

   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "中央揃え"
     .FaceId = 2602
     .OnAction = "'mySetVerticalAlignment " & xlCenter & "'"
   End With

   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "上詰め"
     .FaceId = 2600
     .OnAction = "'mySetVerticalAlignment " & xlTop & "'"
   End With

   Set myCBCtrl = myCB.Controls.Add(ID:=402)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=1742
    .Controls.Add ID:=800
    
   Set myCBCtrl = myCB.Controls.Add(ID:=443)
   myCBCtrl.BeginGroup = True
  
   Set myCBCtrl = myCB.Controls.Add(ID:=298)
   With myCBCtrl
     .Style = msoButtonIcon
     .TooltipText = "《 ウィンドウの整列 》" & vbLf & _
            "・単一ブックで行いたい場合は、" & vbLf & _
            " ウィンドウ→新しいウィンドウを開くで可!!" & vbLf & _
            "・他のアプリケーションとの整列は、" & vbLf & _
            " 下部のタスクバー上で右クリック!!"
   End With
  
    .Controls.Add ID:=541
    .Controls.Add ID:=542
    .Controls.Add ID:=1643
  
   Set myCBCtrl = myCB.Controls.Add(ID:=396)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=397
    .Controls.Add ID:=398
    .Controls.Add ID:=399
    
   Set myCBCtrl = myCB.Controls.Add(ID:=3162)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=3161
  
   Set myCBCtrl = Application.CommandBars.FindControl(ID:=203): _
          myCBCtrl.Copy myCB
  
    .Controls.Add ID:=151
    .Controls.Add ID:=150
    .Controls.Add ID:=1704
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .FaceId = 256
     .OnAction = "罫線"
     .TooltipText = "罫線ダイアログ"
   End With

   Set myCBCtrl = Application.CommandBars.FindControl(ID:=1691): _
          myCBCtrl.Copy myCB
  
  If Val(Application.Version) = 8 Then
   Set myCBCtrl2 = myCB.Controls.Add(Type:=msoControlSplitButtonPopup, ID:=1988)
   Set myCB2 = Application.CommandBars("Pattern")
   For Each myCBCtrl In myCB2.Controls
    With myCBCtrl
      myCBCtrl2.CommandBar.Controls.Add Type:=.Type, ID:=.ID
    End With
   Next
  Else
    .Controls.Add ID:=1988
  End If
  
   Set myCBCtrl = Application.CommandBars.FindControl(ID:=401): _
          myCBCtrl.Copy myCB
    
   Set myCBCtrl = myCB.Controls.Add(ID:=283)
   myCBCtrl.TooltipText = "電卓"
    
    .Controls(28).BeginGroup = True
    .Controls(33).BeginGroup = True
    
    .Visible = True
    .Position = msoBarTop
  
  End With
  
End Sub

【10】つづき
Excel  ぴかる  - 02/9/2(月) 21:07 -

引用なし
パスワード
   Sub オリジナル図形描画作成()
  
  On Error Resume Next
  Application.CommandBars("オリジナル図形描画").Delete
  
  Set myCB = Application.CommandBars.Add(Name:="オリジナル図形描画")
  
  With myCB
    
  
   Set myCBCtrl = Application.CommandBars.FindControl(ID:=30013): _
          myCBCtrl.Copy myCB
   myCBCtrl.Caption = "図形の調整"
    
    .Controls.Add ID:=182
    .Controls.Add ID:=688
  
   Set myCBCtrl = myCB.Controls.Add(ID:=1849)
   myCBCtrl.BeginGroup = True
  
   Set myCBCtrl = myCB.Controls.Add(ID:=313)
   myCBCtrl.Style = msoButtonIcon
    
   Set myCBCtrl = myCB.Controls.Add(ID:=852)
   myCBCtrl.BeginGroup = True
  
   Set myCBCtrl = myCB.Controls.Add(ID:=848)
   With myCBCtrl
     .TooltipText = " 《 シートの移動またはコピー 》" & vbLf & _
            "・ブック内の移動 … シート名部をドラッグ&ドロップでも可" & vbLf & _
            "・ブック内のコピー … [Ctrl]を押しながら、シート名部をドラッグ&ドロップでも可"
     .Style = msoButtonIcon
     .FaceId = 489
   End With
  
   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "シート保護・保護解除"
     .FaceId = 225
     .OnAction = "シート保護"
   End With

   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "シート見出しON・OFF"
     .FaceId = 529
     .OnAction = "シート見出し"
   End With

   Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
   With myCBCtrl
     .TooltipText = "シート選択"
     .FaceId = 461
     .OnAction = "シート選択"
   End With

   Set myCBCtrl = myCB.Controls.Add(ID:=522)
   With myCBCtrl
     .Style = msoButtonIcon
     .FaceId = 2585
   End With
  
   Set myCBCtrl = myCB.Controls.Add(ID:=164)
   With myCBCtrl
     .Style = msoButtonIcon
     .BeginGroup = True
     .TooltipText = " 《 図形のグループ化 》" & vbLf & _
            "[Shift]を押しながら、各図形を選択後、実行"
   End With
  
    .Controls.Add ID:=165
    .Controls.Add ID:=338
  
   Set myCBCtrl = myCB.Controls.Add(ID:=549)
   myCBCtrl.TooltipText = " 《 グリッドに合わせる 》" & vbLf & _
              "図形作成時、セルに位置合わせします。"
   Set myCBCtrl = myCB.Controls.Add(ID:=1402)
   myCBCtrl.TooltipText = " 《 図形に位置を合わせる 》" & vbLf & _
              "図形作成時、他の図形に位置合わせします。"
  
   Set myCBCtrl = myCB.Controls.Add(ID:=166)
   myCBCtrl.Style = msoButtonIcon
   Set myCBCtrl = myCB.Controls.Add(ID:=167)
   myCBCtrl.Style = msoButtonIcon
  
   Set myCBCtrl = Application.CommandBars.FindControl(ID:=30177): _
          myCBCtrl.Copy myCB
   myCBCtrl.Caption = "オートシェイプ"
  
   Set myCBCtrl = myCB.Controls.Add(ID:=130)
   myCBCtrl.TooltipText = " 《 直線 》" & vbLf & _
              "・ダブルクリックにて連続直線となります。" & vbLf & _
              "・連続直線の場合は、[図形に合わせる]との併用をお勧めします。"
  
    .Controls.Add ID:=243
    .Controls.Add ID:=409
    
   Set myCBCtrl = myCB.Controls.Add(ID:=1111)
   myCBCtrl.TooltipText = " 《 四角形 》" & vbLf & _
              "[Shift]を押しながら行うと正方形なります。"
   Set myCBCtrl = myCB.Controls.Add(ID:=1119)
   myCBCtrl.TooltipText = " 《 楕円 》" & vbLf & _
              "[Shift]を押しながら行うと真円なります。"
  
    .Controls.Add ID:=139
    .Controls.Add ID:=318
    .Controls.Add ID:=1031
    .Controls.Add ID:=682
    
   Set myCBCtrl = myCB.Controls.Add(ID:=1691)
   myCBCtrl.BeginGroup = True
  
    .Controls.Add ID:=1692
    .Controls.Add ID:=401
    .Controls.Add ID:=692
    .Controls.Add ID:=693
    .Controls.Add ID:=694
    .Controls.Add ID:=394
    .Controls.Add ID:=339
    .Controls(19).BeginGroup = True
    
    .Visible = True
    .Position = msoBarBottom
  
  End With
  
  Set myCB = Nothing: Set myCB2 = Nothing: Set myCBCtrl = Nothing: Set myCBCtrl2 = Nothing

End Sub

【11】パレート図
Excel  ぴかる  - 02/9/2(月) 21:08 -

引用なし
パスワード
   Option Explicit
Public フラグ
Sub パレート図作成()

Dim タイトル As String
Dim スタイル As String
Dim メッセージ As String
Dim YESNO As String
Dim Book名 As String
Dim シート名 As String
Dim SEL行 As Long
Dim SEL列 As Long
Dim 最終行 As Long
Dim 合計値 As Long
Dim 途中合計値 As Long
Dim I As Long
  
  If ActiveSheet.ProtectContents Then
  Else
  
  メッセージ = "パレート図を作成します。" & vbLf & "" & vbLf & _
        "《 ルール 》" & vbLf & _
        " ・元データ左上のセルにセレクトして下さい。。" & vbLf & _
        " ・範囲は、項目列・データ列の2列で構成の事とします。" & vbLf & _
        " ・データ最下段下・データ列右は、空白セルである事とします。" & vbLf & "" & vbLf & _
        "《 動作説明 》" & vbLf & _
        " ・自動で比率を計算し、並び替えを行います。" & vbLf & _
        " ・データ最下段が『その他』であれば、その部分は" & vbLf & _
        "  並び替えを行いません。" & vbLf & "" & vbLf & _
        "よろしいですか。"
  スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
  タイトル = " 【 パレート図作成 】"
  YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
  If YESNO = vbYes Then
  
  On Error GoTo エラー処理
  Application.ScreenUpdating = False  '画面固定
  
  フラグ = 1
  シート名 = ActiveSheet.Name
  Book名 = ActiveWorkbook.Name
  SEL行 = Selection.Row
  SEL列 = Selection.Column
  
  If Not IsNumeric(Cells(SEL行, SEL列 + 1)) Then  '入力値が数字かどうか調べる
   SEL行 = SEL行 + 1
  End If
  
  最終行 = Cells(SEL行, SEL列).End(xlDown).Row
  
  For I = SEL行 To 最終行
   Cells(I, SEL列).Select
   If Cells(I, SEL列) = "" Then
    Application.ScreenUpdating = True  '画面固定解除
    MsgBox "セレクト位置には、データがありません。", vbInformation, タイトル
    Exit Sub
   End If
   If IsNumeric(Cells(I, SEL列)) Then
    Application.ScreenUpdating = True  '画面固定解除
    MsgBox "項目列は、文字のみが有効です。", vbInformation, タイトル
    Exit Sub
   End If
  Next
  
  For I = SEL行 To 最終行
   Cells(I, SEL列 + 1).Select
   If Not IsNumeric(Cells(I, SEL列 + 1)) Then
    Application.ScreenUpdating = True  '画面固定解除
    MsgBox "データ列は、数値のみが有効です。", vbInformation, タイトル
    Exit Sub
   End If
  Next
  
  For I = SEL行 - 1 To 最終行
   Cells(I, SEL列 + 2).Select
   If Cells(I, SEL列 + 2) <> "" Then
    Application.ScreenUpdating = True  '画面固定解除
    MsgBox "データ列右横は、空白にして下さい。", vbInformation, "パレート図作成不可"
    Exit Sub
   End If
  Next
  
  Cells(SEL行 - 1, SEL列 + 2) = 0
 
  If Cells(最終行, SEL列) = "その他" Then
   Range(Cells(SEL行, SEL列), Cells(最終行 - 1, SEL列 + 1)).Sort Key1:=Cells(SEL行, SEL列 + 1), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin
  Else
   Range(Cells(SEL行, SEL列), Cells(最終行, SEL列 + 1)).Sort Key1:=Cells(SEL行, SEL列 + 1), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin
  End If

  合計値 = 0
 
  For I = SEL行 To 最終行
   合計値 = 合計値 + Cells(I, SEL列 + 1)
  Next
 
  Range(Cells(SEL行 - 1, SEL列 + 2), Cells(最終行, SEL列 + 2)).NumberFormatLocal = "0%"
 
  途中合計値 = 0
  For I = SEL行 To 最終行
   途中合計値 = 途中合計値 + Cells(I, SEL列 + 1)
   Cells(I, SEL列 + 2) = 途中合計値 / 合計値
  Next

  Range(Cells(SEL行, SEL列), Cells(最終行, SEL列 + 2)).Select
  Charts.Add
  ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="2 軸上の折れ線と縦棒"
  ActiveChart.Location Where:=xlLocationAsObject, Name:=シート名
 
  With ActiveChart
    .Axes(xlValue, xlSecondary).MaximumScale = 1
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).MaximumScale = 合計値
    .ChartGroups(1).GapWidth = 0
    .Axes(xlValue, xlSecondary).MajorUnit = 0.2
    .HasLegend = False
    .ChartArea.Font.Size = 9
    .SeriesCollection(2).Values = "=" & シート名 & "!R" & SEL行 - 1 & "C" & SEL列 + 2 & _
                  ":R" & 最終行 & "C" & SEL列 + 2
    .SeriesCollection(2).MarkerStyle = xlCircle
    .SeriesCollection(2).MarkerSize = 4
    .HasAxis(xlCategory, xlSecondary) = True
    .Axes(xlCategory, xlSecondary).AxisBetweenCategories = False
    .Axes(xlCategory, xlSecondary).TickLabels.Font.Size = 1
    .Axes(xlCategory, xlSecondary).TickLabels.Font.ColorIndex = 2
    .Axes(xlCategory, xlSecondary).TickLabels.Font.Background = xlTransparent
    .PlotArea.Interior.ColorIndex = 2
    .SeriesCollection(1).Interior.ColorIndex = 8
   End With
  
  ActiveWindow.Visible = False
  Windows(Book名).Activate
  Cells(SEL行, SEL列).Select
  Application.ScreenUpdating = True  '画面固定解除
  MsgBox "パレート図が完成しました。" & vbLf & "詳細は、各個人で設定してください。 " _
      , vbInformation, タイトル
 
  フラグ = 1
  Exit Sub

エラー処理:
 
  フラグ = 0
  MsgBox "エラーが、発生しました。"
 
  Else
   MsgBox "キャンセルしました。", vbInformation, タイトル
  End If

  End If

End Sub

【12】メイン
Excel  ぴかる  - 02/9/2(月) 21:15 -

引用なし
パスワード
   Dim X As New Class1
Sub AUTO_OPEN()

  If ThisWorkbook.Name = "ピカつーる.xla" Then
   Set X.App = Application
   InitializeBook ActiveWorkbook
  ElseIf ThisWorkbook.Name = "ピカせっと.xls" Then
   ピカつーる作成
  End If
  
End Sub
Sub AUTO_CLOSE()

  If (ThisWorkbook.Path = "") And (フラグ <> 1) Then
   ピカせっと作成
  End If

End Sub
Sub InitializeBook(WBook)
  
   Set X.WBK = WBook

End Sub
Sub mySetVerticalAlignment(Ichi As Variant)
  
  Selection.VerticalAlignment = Ichi
  With Application.CommandBars("オリジナル書式設定")
    .Controls(12).State = msoButtonUp
    .Controls(13).State = msoButtonUp
    .Controls(14).State = msoButtonUp
  
   Select Case Ichi
   Case xlBottom
    .Controls(12).State = msoButtonDown
   Case xlCenter
    .Controls(13).State = msoButtonDown
   Case xlTop
    .Controls(14).State = msoButtonDown
   End Select
  End With
 
End Sub
Sub ShiyoKa(Kanou As Boolean)
   
  If ThisWorkbook.Name = "ピカつーる.xla" Then
   With Application.CommandBars("オリジナル書式設定")
    .Controls(12).State = msoButtonUp
    .Controls(13).State = msoButtonUp
    .Controls(14).State = msoButtonUp
    .Controls(12).Enabled = Kanou
    .Controls(13).Enabled = Kanou
    .Controls(14).Enabled = Kanou
   End With
  End If
  
End Sub
Sub オリジナルツールバー作成()

  Application.ScreenUpdating = False 
  右クリック部追加
  既存ツールバーを非表示
  オリジナル標準作成
  オリジナル書式設定作成
  オリジナル図形描画作成
  オリジナル図形描画作成
  オリジナルメニューバー作成
  AUTO_OPEN
 
End Sub
Sub ツールバーを元に戻す()
  
  Dim cb As CommandBar
  
  Application.ScreenUpdating = False  '画面固定
  With Application
    .CommandBars("オリジナル書式設定").Delete
    .CommandBars("オリジナル図形描画").Delete
    .CommandBars("オリジナル標準").Delete
    .CommandBars("PikaBar").Delete
    .CommandBars("Worksheet Menu Bar").Enabled = True
    .CommandBars("Standard").Visible = True
    .CommandBars("Formatting").Visible = True
  End With
  
  For Each cb In Application.CommandBars
   If cb.Name = "Cell" Then cb.Reset
  Next

End Sub
Sub 元に戻す()
  
Dim タイトル As String
Dim スタイル As String
Dim メッセージ As String
Dim YESNO As String
   
   メッセージ = "ツールバーを元に戻します。よろしいですか?" & vbLf & _
          "" & vbLf & _
          "再びピカつーるにしたい時は、ツール→アドインにて" & vbLf & _
          "ピカつーるにチェックを入れて下さい。"
   スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
   タイトル = " 【 ツールバー 】"
   YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
   If YESNO = vbYes Then
    Application.DisplayAlerts = False '警告メッセージオフにする
    AddIns("ピカつーる").Installed = False
   Else
    MsgBox "キャンセルしました。", vbInformation, タイトル
    Exit Sub
   End If
  
End Sub

【13】メニューバー
Excel  ぴかる  - 02/9/2(月) 21:19 -

引用なし
パスワード
   Sub オリジナルメニューバー作成()

Dim myCB As CommandBar
Dim myCBCtrl As CommandBarControl
Dim myCBBtn As CommandBarButton
Dim myCBpup As CommandBarPopup

  On Error Resume Next
  Application.CommandBars("PikaBar").Delete
  On Error GoTo 0
  Set myCB = Application.CommandBars.Add(Name:="PikaBar", Position:=msoBarTop, MenuBar:=True)
  
  With Application.CommandBars(1)
    For II% = 1 To 9
      Select Case II%
        Case 7:  IdNum& = 30011
        Case Else: IdNum& = 30000 + II% + 1
      End Select
      Set myCBCtrl = .FindControl(ID:=IdNum&): myCBCtrl.Copy myCB, II%
    Next
  End With
  
  Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
  With myCBCtrl
    .Caption = "セル書式"
    .BeginGroup = True
    .OnAction = "列Caption"
  End With
    
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "表示形式"
     .OnAction = "表示形式"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "配置"
     .OnAction = "配置"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "フォント"
     .OnAction = "フォント"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "罫線"
     .OnAction = "罫線"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "パターン"
     .OnAction = "パターン"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "保護"
     .OnAction = "保護"
   End With
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(ID:=3058)
   myCBCtrl.BeginGroup = True
   
   Set myCBCtrl = myCB.Controls("セル書式").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "列形式A1…R1C1"
     .OnAction = "列表示切替"
   End With
   
  Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
  With myCBCtrl
    .Caption = "入力設定"
    .OnAction = "入力設定ON"
  End With
  
   Set myCBCtrl = myCB.Controls("入力設定").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .FaceId = 984
     .Caption = "操作説明"
     .Style = msoButtonIconAndCaption
    If Val(Application.Version) <> 8 Then
     .OnAction = "入力設定操作説明"
    Else
     .OnAction = "入力設定操作説明97"
    End If
   End With
   
  Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
  myCBpup.Caption = "入力範囲設定"
  myCBpup.BeginGroup = True
  
   Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
   With myCBBtn
     .Caption = "入力範囲ロック"
     .OnAction = "入力範囲ロック"
   End With
   
   Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
   With myCBBtn
     .Caption = "一時解除"
     .OnAction = "一時解除"
   End With
   
   Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
   With myCBBtn
     .Caption = "再設定"
     .OnAction = "再設定"
   End With
   
  Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
  With myCBpup
    .Caption = "日本語入力"
  End With
  For II% = 1 To 3
    Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
    With myCBBtn
      Select Case II%
        Case 1: .Caption = "オン固定"
        Case 2: .Caption = "オフ固定"
        Case 3: .Caption = "コントロールなし"
      End Select
      .OnAction = "変換_" & Format(II%)
    End With
  Next
  '
  Set myCBpup = myCB.Controls("入力設定").Controls.Add(Type:=msoControlPopup)
  With myCBpup
    .Caption = "Enter移動"
  End With
  For II% = 1 To 5
    Set myCBBtn = myCBpup.Controls.Add(Type:=msoControlButton)
    With myCBBtn
      Select Case II%
        Case 1: .Caption = "下"
        Case 2: .Caption = "右"
        Case 3: .Caption = "上"
        Case 4: .Caption = "左"
        Case 5: .Caption = "−"
      End Select
      .OnAction = "方向_" & Format(II%, "0")
    End With
  Next

【14】つづき
Excel  ぴかる  - 02/9/2(月) 21:20 -

引用なし
パスワード
     Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
  myCBCtrl.Caption = "文字変換"
    
   Set myCBCtrl = myCB.Controls("文字変換").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .FaceId = 984
     .Caption = "操作説明"
     .Style = msoButtonIconAndCaption
    If Val(Application.Version) <> 8 Then
     .OnAction = "文字変換操作説明"
    Else
     .OnAction = "文字変換操作説明97"
    End If
   End With
   
   Set myCBCtrl = myCB.Controls("文字変換").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "・全角"
     .OnAction = "全角"
     .BeginGroup = True
   End With
   
   Set myCBCtrl = myCB.Controls("文字変換").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "・半角"
     .OnAction = "半角"
   End With
   
   Set myCBCtrl = myCB.Controls("文字変換").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "・大文字"
     .OnAction = "大文字"
   End With
   
   Set myCBCtrl = myCB.Controls("文字変換").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "・小文字"
     .OnAction = "小文字"
   End With
   
  Set myCBCtrl = myCB.Controls.Add(Type:=msoControlPopup)
  myCBCtrl.Caption = "小ワザ集"
    
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "コピー・貼り付け"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技コピー貼り付け"
    Else
     .OnAction = "小技97コピー貼り付け"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "文字表示"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技文字表示"
    Else
     .OnAction = "小技97文字表示"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "表示形式"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技表示形式"
    Else
     .OnAction = "小技97表示形式"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "[Shift][Ctrl]キー"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技シフトコントロール"
    Else
     .OnAction = "小技97シフトコントロール"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "関数"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技関数"
    Else
     .OnAction = "小技97関数"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "条件付き書式"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技条件付き書式"
    Else
     .OnAction = "小技97条件付き書式"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "入力規則"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技入力規則"
    Else
     .OnAction = "小技97入力規則"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "セルの保護"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技セルの保護"
    Else
     .OnAction = "小技97セルの保護"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "データベース"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技データベース"
    Else
     .OnAction = "小技97データベース"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "マクロ"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技マクロ"
    Else
     .OnAction = "小技97マクロ"
    End If
     .FaceId = 984
   End With
   
   Set myCBCtrl = myCB.Controls("小ワザ集").Controls _
    .Add(Type:=msoControlButton)
   With myCBCtrl
     .Caption = "おまけ"
    If Val(Application.Version) <> 8 Then
     .OnAction = "小技おまけ"
    Else
     .OnAction = "小技97おまけ"
    End If
     .FaceId = 984
   End With
   
  Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton)
  With myCBCtrl
    .Style = msoButtonCaption
    .Caption = "元に戻す"
    .OnAction = "元に戻す"
  End With
    
  myCB.Visible = True

  Set myCB = Nothing: Set myCBCtrl = Nothing: Set myCBBtn = Nothing: Set myCBpup = Nothing

End Sub

【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

【16】小ワザ集
Excel  ぴかる  - 02/9/2(月) 21:23 -

引用なし
パスワード
   Sub 小技コピー貼り付け()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 コピー・貼り付けをうまく活用するには 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 値の貼り付け 】{cf 0}" & vbLf & _
             "  数式部の数値(答え)のみを貼り付けたい時に使用します。" & vbLf & _
             "  書式を変えずに値だけを貼り付けたい時にも使用します。"
    .Labels(2).Text = "{cf 252}【 書式の貼り付け 】{cf 0}" & vbLf & _
             "  コピー部の書式(フォント・罫線等)のみの貼り付け機能です。"
    .Labels(3).Text = "{cf 252}【 隣接セルへのコピー(オートフィル) 】{cf 0}" & vbLf & _
             "{cf 2} [ 操作方法 ]{cf 0}" & vbLf & _
             "  1.コピーしたい部分を選択する。" & vbLf & _
             "  2.セルの右下にマウスを合わせ、{cf 249}黒十字{cf 0}を表示させる。" & vbLf & _
             "  3.左クリックしながら、コピー方向へ移動する。" & vbLf & _
             "  4.終了位置で、左クリックを解除する。" & vbLf & _
             "     ・左クリック … そのままコピー(文字列に数値があると数値UPします)" & vbLf & _
             "     ・右クリック … 選択してコピー"
    .Labels(4).Text = "{cf 252}【 数値の連続(UP)コピー 】{cf 0}" & vbLf & _
             "  上記2.の操作と{cf 249}[Ctrl]{cf 0}キーONにて、{cf 249}+ {cf 0}も表示させる。" & vbLf & _
             "  以降、3.4.の操作を行う。"
    .Labels(5).Text = "{cf 252}【 セルの移動 】{cf 0}" & vbLf & _
             "{cf 2} [ 操作方法 ]{cf 0}" & vbLf & _
             "  1.移動したい部分を選択する。" & vbLf & _
             "  2.セルの下にマウスを合わせ、{cf 249}白矢印{cf 0}を表示させる。" & vbLf & _
             "  3.左クリックしながら、移動させる。" & vbLf & _
             "  4.移動位置で、左クリックを解除する。" & vbLf & _
             "     ・左クリック … 移動" & vbLf & _
             "     ・右クリック … 各種選択" & vbLf & _
             "" & vbLf & _
             "{cf 2}非常に便利な機能です。操作時間短縮になりますよ!"
    .Show
  
  End With

End Sub
Sub 小技文字表示()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 1セル内に文字列を収める方法 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 自動縮小 】" & vbLf & _
             "{cf 0}  セルの書式設定→配置→縮小して全体を表示にチェックを入れる。"
    .Labels(2).Text = "{cf 252}【 セル内で文字列を折り返す 】" & vbLf & _
             "{cf 0}  ・セルの書式設定→配置→折り返して全体を表示にチェックを入れる。" & vbLf & _
             "  ・任意の位置で折り返す場合は、その位置で{cf 249}[Alt][Enter]キー{cf 0}を" & vbLf & _
             "   同時に押す。"
    .Labels(3).Text = "{cf 252}【 適正の列幅にするには 】{cf 0}" & vbLf & _
             "{cf 0} 列表示部の右境界線にてダブルクリックを行う。" & vbLf & _
             "  (最長文字列セルに合わせた列幅となります。)"
    .Labels(4).Text = "{cf 252}【 文字位置 】{cf 0}" & vbLf & _
             "{cf 0} ・インテンド(左空白)を使用すると見栄えがよくなります。" & vbLf & _
             " ・数字の場合は、表示形式を数値すると右に空白が出来ます。"
    .Labels(5).Text = "{cf 252}【 セル内の文字列を文字別にフォント設定するには? 】" & vbLf & _
             "{cf 0}  左クリックでの文字範囲選択にてフォント設定が可能となります。"
    .Show
  
  End With

End Sub
Sub 小技表示形式()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 表示形式をうまく活用するには? 》{ul 0}   "
    .Text = String(40, " ")

    .Labels(1).Text = "{cf 2}[書式]→[セル]→[表示形式]の活用"
    .Labels(2).Text = "{cf 252}【 数値 】" & vbLf & _
             "{cf 0}  データセルを数値にするだけで、若干{cf 249}右に空白{cf 0}が出来ます。" & vbLf & _
             "  見栄えにこだわる方にお勧めです。"
    .Labels(3).Text = "{cf 252}【 日付 】" & vbLf & _
             "{cf 0}  沢山の中から、好みの形式に選択出来ます。" & vbLf & _
             "  ユーザー定義にて更に設定可能です。"
    .Labels(4).Text = "{cf 252}【 ユーザー定義 】{cf 0}" & vbLf & _
             "{cf 2} [曜日を付ける]" & vbLf & _
             "{cf 0}  aaaa-火曜日 aaa-火" & vbLf & _
             "  dddd-Tuesday ddd-Tue" & vbLf & _
             "  例) 7/31(水)と表示するには、m/d""(""aaa"")""と入力する。" & vbLf & _
             "{cf 2} [数値単位をつける]" & vbLf & _
             "{cf 0}  0""台"" 0""個"" と入力でOK。" & vbLf & _
             "  文字列の場合は、@を使用します。"
    .Show
  
  End With

End Sub
Sub 小技シフトコントロール()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 [Shift][Ctrl]キーをうまく活用するには 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 範囲選択 】{cf 0}" & vbLf & _
             "{cf 2}  {ul 1}[ Shift ]キー{cf 0}{ul 0}" & vbLf & _
             "   まず、始点をクリックして{cf 249}[Shift]{cf 0}キーを押しながら終点をクリックするとその" & vbLf & _
             "   囲った範囲が選択されます。" & vbLf & _
             "{cf 2}  {ul 1}[ Ctrl ]キー{cf 0}{ul 0}" & vbLf & _
             "  {cf 249}[Ctrl]{cf 0}キーを押しながらをクリックしていくと、トビトビで範囲選択が行えます。" & vbLf & _
             "{cf 2}  {ul 1}[ データベース範囲の選択 ]{cf 0}{ul 0}" & vbLf & _
             "   データベースの1セルをクリックして、{cf 249}[Shift][Ctrl][*]{cf 0}キーを同時に押すと" & vbLf & _
             "   データベース範囲が選択されます。"
    .Labels(2).Text = "{cf 252}【 エクスプローラのファイル選択も同じ 】{cf 0}" & vbLf & _
             "  {cf 249}[Shift][Ctrl]{cf 0}キーで上記と同じやり方でファイル選択出来ます。" & vbLf & _
             "  ファイル名の少し右から、左クリックにてファイルを囲っても出来ます。"
    .Labels(3).Text = "{cf 252}【 データの各端への移動 】{cf 0}" & vbLf & _
             "  {cf 249}[Ctrl][矢印]{cf 0}キー同時ONにて端セルに移動します。"
    .Labels(4).Text = "{cf 252}【 選択範囲の同時入力 】{cf 0}" & vbLf & _
             "  範囲選択後、入力時{cf 249}[Ctrl][Enter]{cf 0}キーを同時ONにて可能です。" & vbLf & _
             "" & vbLf & _
             "{cf 2}ショートカットキーは他にも多々あります。興味のある方は調べてみて下さい。"
    .Show
  
  End With

End Sub
Sub 小技関数()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 ちょっとした関数テクニック 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 ""$""をうまく使う 】" & vbLf & _
             "{cf 2} [""$""って(相対と絶対)?]" & vbLf & _
             "{cf 0}  相対…B1セル""=A1""をB2セルにコピーすると""=A2""となります。" & vbLf & _
             "      つまり、行・列に対応した参照となります。" & vbLf & _
             "  絶対…C1セル""=$A$1*B1""をC2セルにコピーすると""=$A$1*B2""となります。" & vbLf & _
             "      つまり、{cf 249}${cf 0}を付けた部分が{cf 249}固定{cf 0}となります。" & vbLf & _
             "      左の{cf 249}${cf 0}が列用、右の{cf 249}${cf 0}が行用です。" & vbLf & _
             "{cf 2} [""$""を簡単に入力には?]" & vbLf & _
             "  {cf 249}(F4){cf 0}を押していくと{cf 249}${cf 0}位置が切替っていきます。" & vbLf & _
             "{cf 2} [まとめ]" & vbLf & _
             "{cf 0}  固定部分を見極めて、容易にコピー出来る形にしましょう。"
    .Labels(2).Text = "{cf 252}【 ""IF文""をうまく使う 】" & vbLf & _
             "{cf 2} [""IF文""って?]" & vbLf & _
             "{cf 0}  条件に対して、一致時・不一致時の処理に分ける事が出来ます。" & vbLf & _
             "  例) A1が70以上であれば○、未満であれば×は、" & vbLf & _
             "     =IF(A1>=70,""○"",""×"") となります。" & vbLf & _
             "{cf 2} [ エラーを回避するには ]" & vbLf & _
             "{cf 249}  =A1/B1{cf 0}という数式で{cf 249}B1セルが空白{cf 0}の場合は、{cf 249}#DIV/0!{cf 0}が発生します。" & vbLf & _
             "  あまりセンスが良いと言えないのでIF分で回避しましょう!。" & vbLf & _
             "  {cf 249}=IF(B1>0,A1/B1,""""){cf 0} でOK。"
    .Labels(3).Text = "{cf 252}【 便利な関数 】{cf 0}" & vbLf & _
             "  ・SUMIF … 条件に一致した合計を計算。" & vbLf & _
             "  ・VLOOKUP … 条件に一致した項目を抽出。" & vbLf & _
             "  詳しくは、ヘルプ等にて。他にも多々有りますが・・・。"
    .Show
  
  End With

End Sub

【17】つづき
Excel  ぴかる  - 02/9/2(月) 21:25 -

引用なし
パスワード
   Sub 小技条件付き書式()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 条件によって書式変更するには? 》{ul 0}   "
    .Text = String(32, " ")

    .Labels(1).Text = "{cf 252}【 条件付き書式を使う 】" & vbLf & _
             "{cf 0} ・セルの値によって、書式設定する事が出来ます。" & vbLf & _
             "" & vbLf & _
             "  例1) 100以上で赤字にする。" & vbLf & _
             "      セルの値が 100以上 赤字に設定" & vbLf & _
             "" & vbLf & _
             "  例2) A1セルが空白ならで白字にする。" & vbLf & _
             "      数式が =$A$1="""" 白字に設定" & vbLf & _
             "" & vbLf & _
             " ・条件設定は、3つまで可能です。" & vbLf & _
             "" & vbLf & _
             "{cf 2}非常に便利な機能です。さあ、使ってみよう!"
    .Show
  
  End With

End Sub
Sub 小技入力規則()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 入力規則をうまく活用するには? 》{ul 0}   "
    .Text = String(32, " ")

    .Labels(1).Text = "{ul 1}{cf 2}データ→入力規則の使用例紹介{ul 0}" & vbLf & _
             ""
    .Labels(2).Text = "{cf 252}【 リスト機能 】" & vbLf & _
             "{cf 0} ・手入力ではなくリストから簡易入力する事が出来ます。" & vbLf & _
             "" & vbLf & _
             "  {ul 1}例) 取引先社名をリストから入力する。{ul 0}" & vbLf & _
             "" & vbLf & _
             "    1. 取引先社名リストを入力シート内に作成する。" & vbLf & _
             "     (少し外れた所に1列にて作成の事!)" & vbLf & _
             "    2. データ→入力規則を選択する。" & vbLf & _
             "    3. 入力値の種類をリストにする。" & vbLf & _
             "    4. 元の値を取引先社名リストセルに合わせる。" & vbLf & _
             "    5. [OK]をクリックにて完了。"
    .Labels(3).Text = "{cf 252}【 整数 】" & vbLf & _
             "{cf 0} 数値入力固定箇所に用います。"
    .Labels(4).Text = "{cf 252}【 入力時メッセージ 】" & vbLf & _
             "{cf 0} 特定のセルに合わせた時にコメント表示が出来ます。" & vbLf & _
             "" & vbLf & _
             "{cf 2}非常に便利な機能です。さあ、使ってみよう!"
    .Show
  
  End With

End Sub
Sub 小技セルの保護()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 セルの保護を活用するには、 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 数式部に保護をかけ、データ部のみ入力可にするには 】{cf 0}" & vbLf & _
             "  1.行列部左上角クリックもしくは、[Ctrl]+[A]にて全セル選択とする。" & vbLf & _
             "  2.セルの書式設定→保護→ロックのチェックを外す。" & vbLf & _
             "  3.保護をしたい部分(数式部)を選択する。。" & vbLf & _
             "  4.セルの書式設定→保護→ロックにチェックを入れる。" & vbLf & _
             "  5.ツール→保護→シートの保護を行う。" & vbLf & _
             "" & vbLf & _
             "{cf 2}数式の多い入力シートに使うと安心です。"
    .Show
  
  End With

End Sub
Sub 小技データベース()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 データベースを活用するには 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 データベースって? 】{cf 0}" & vbLf & _
             "  データベースとは、{cf 249}最上段に各種項目{cf 0}があり以下{cf 249}下段は全てデータ{cf 0}で" & vbLf & _
             "  構成されているものをいいます。" & vbLf & _
             "   例)在庫管理台帳" & vbLf & _
             "     品名  型式 単価  在庫数  合計" & vbLf & _
             "     ビデオ  A-1  8,000   5   40,000" & vbLf & _
             "     ビデオ  A-2  9,000   3   27,000 " & vbLf & _
             "     テレビ  B-1  20,000   7  140,000" & vbLf & _
             "     テレビ  B-2  50,000   2  100,000" & vbLf & _
             "     カメラ  C-1  30,000   3   60,000" & vbLf & _
             "     カメラ  C-2  50,000   3   15,000"
    .Labels(2).Text = "{cf 252}【 オートフィルタ機能 】{cf 0}" & vbLf & _
             "  抽出したい項目のみを表示することが出来ます。" & vbLf & _
             "   例)テレビのみ、単価10,000以上等の表示切替等" & vbLf & _
             "     オプション機能も充実しており、いろんな事が可能です。"
    .Labels(3).Text = "{cf 252}【 集計機能 】{cf 0}" & vbLf & _
             "  データベース表示に各項目の合計等を追加表示出来ます。" & vbLf & _
             "  アウトライン(行表示切替)も自動で形成されます。"
    .Labels(4).Text = "{cf 252}【 ピボットテーブル 】{cf 0}" & vbLf & _
             "  集計したい条件を配置して、各種集計(合計・平均・個数等)出来ます。" & vbLf & _
             "  非常に便利な機能です。ヘルプ・書籍等を参考にして下さい。"
    .Labels(5).Text = "{cf 252}【 データベース関数 】{cf 0}" & vbLf & _
             "  演算条件を作成し、合計・個数等を求めることが出来ます。" & vbLf & _
             "  少し難しい関数です。ヘルプ・書籍等を参考にして下さい。" & vbLf & _
             "" & vbLf & _
             "{cf 2}業務で集計をされている方は、是非ともこの機能を使ってみて下さい!"
    .Show
  
  End With

End Sub

【18】つづきのつづき
Excel  ぴかる  - 02/9/2(月) 21:25 -

引用なし
パスワード
   Sub 小技マクロ()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 マクロ 》{ul 0}   "
    .Text = String(45, " ")

    .Labels(1).Text = "{cf 252}【 マクロって? 】{cf 0}" & vbLf & _
             "  マクロとは、通常手動で行っている操作を自動で行うプログラムのことです。"
    .Labels(2).Text = "{cf 252}【 どういう時に使うと便利? 】{cf 0}" & vbLf & _
             "  毎日、ひとつのブックで同じ操作を行っている項目があると思います。" & vbLf & _
             "  例えば、データのクリア・印刷等です。このような操作をもっと容易に" & vbLf & _
             "  行いたいと思った方は、是非ともマクロを使うべきです。"
    .Labels(3).Text = "{cf 252}【 どうやって作るの? 】{cf 0}" & vbLf & _
             "  マクロの記録という非常に便利な機能があります。これは、実際の操作を" & vbLf & _
             "  自動的にプログラム化してくれる機能です。マクロって難しいそうと思う" & vbLf & _
             "  前にやってみましょう。"
    .Labels(4).Text = "{cf 252}【 マクロボタンを作ってみよう! 】{cf 0}" & vbLf & _
             "  それでは、シート上にボタンを設置してマクロを登録してみましょう。" & vbLf & _
             "   1.マクロ化したい操作をまとめる。" & vbLf & _
             "   2.ツールバー右の方のボタンをクリックしてシート上に設置する。" & vbLf & _
             "   3.マクロの登録にて記録をオンにする。" & vbLf & _
             "   4.実際の操作を行う。" & vbLf & _
             "   5.ツールバーのボタン2個右横の記録終了をオンにする。" & vbLf & _
             "   6.マクロボタンを押して、動作を確認する。"
    .Labels(5).Text = "{cf 252}【 マクロを編集するには? 】{cf 0}" & vbLf & _
             "  ツールバー右端のVisual Basic Editorにて編集が出来ます。" & vbLf & _
             "  詳しい内容は、書籍等を参考にして下さい。" & vbLf & _
             "" & vbLf & _
             "{cf 2}興味を持たれた方は、トライしてみましょう!"
    .Show
  
  End With

End Sub

Sub 小技おまけ()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 おまけ 》{ul 0}   "
    .Text = String(40, " ")

    .Labels(1).Text = "{cf 252}【 折れ線グラフの数値の無い部分をつなぐには? 】" & vbLf & _
             "{cf 0}  データ空白部を{cf 249}#N/A{cf 0}にすると直線でつなぐことが出来ます。"
    .Labels(2).Text = "{cf 252}【 オプションの表示切替機能 】{cf 0}" & vbLf & _
             "  [行列番号][スクロールバー ][枠線][シート名][0表示]等の" & vbLf & _
             "  表示切替が、可能です。見栄えにこだわる方にお勧めです。"
    .Labels(3).Text = "{cf 252}【 検索機能 】{cf 0}" & vbLf & _
             "  [編集]→[検索]" & vbLf & _
             "  検索したい文字入力にて同シート内での検索が可能となります。"
    .Labels(4).Text = "{cf 252}【 置換機能 】{cf 0}" & vbLf & _
             "  [編集]→[置換] … 選択範囲において" & vbLf & _
             "  変更前の文字と変更後の文字入力にて置換が可能となります。" & vbLf & _
             "   [A1→B1]  検索文字…A  置換文字…B" & vbLf & _
             "   [A_A→AA]  検索文字…_  置換文字…無" & vbLf & _
             "     {cf 249}↑スペースの削除{cf 0} "
    .Labels(5).Text = "{cf 252}【 文字列を任意位置にて分割するには 】{cf 0}" & vbLf & _
             "  [データ]→[区切り位置]→[スペースによって・・・]を選択。" & vbLf & _
             "  分割したい位置をマウスにて区切って実行すると分割されます。" & vbLf & _
             "  右セルは空白である事とします。 "
    .Show
  
  End With

End Sub

【19】小ワザ集97
Excel  ぴかる  - 02/9/2(月) 21:27 -

引用なし
パスワード
   Sub 小技97コピー貼り付け()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 コピー・貼り付けをうまく活用するには 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 値の貼り付け 】" & vbLf & _
             "  数式部の数値(答え)のみを貼り付けたい時に使用します。" & vbLf & _
             "  書式を変えずに値だけを貼り付けたい時にも使用します。"
    .Labels(2).Text = "【 書式の貼り付け 】" & vbLf & _
             "  コピー部の書式(フォント・罫線等)のみの貼り付け機能です。"
    .Labels(3).Text = "【 隣接セルへのコピー(オートフィル) 】" & vbLf & _
             " [ 操作方法 ]" & vbLf & _
             "  1.コピーしたい部分を選択する。" & vbLf & _
             "  2.セルの右下にマウスを合わせ、黒十字を表示させる。" & vbLf & _
             "  3.左クリックしながら、コピー方向へ移動する。" & vbLf & _
             "  4.終了位置で、左クリックを解除する。" & vbLf & _
             "     ・左クリック … そのままコピー(文字列に数値があると数値UPします)" & vbLf & _
             "     ・右クリック … 選択してコピー"
    .Labels(4).Text = "【 数値の連続(UP)コピー 】" & vbLf & _
             "  上記2.の操作と[Ctrl]キーONにて、+ も表示させる。" & vbLf & _
             "  以降、3.4.の操作を行う。"
    .Labels(5).Text = "【 セルの移動 】" & vbLf & _
             " [ 操作方法 ]" & vbLf & _
             "  1.移動したい部分を選択する。" & vbLf & _
             "  2.セルの下にマウスを合わせ、白矢印を表示させる。" & vbLf & _
             "  3.左クリックしながら、移動させる。" & vbLf & _
             "  4.移動位置で、左クリックを解除する。" & vbLf & _
             "     ・左クリック … 移動" & vbLf & _
             "     ・右クリック … 各種選択" & vbLf & _
             "" & vbLf & _
             "非常に便利な機能です。操作時間短縮になりますよ!"
    .Show
  
  End With

End Sub
Sub 小技97文字表示()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 1セル内に文字列を収める方法 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 自動縮小 】" & vbLf & _
             "  セルの書式設定→配置→縮小して全体を表示にチェックを入れる。"
    .Labels(2).Text = "【 セル内で文字列を折り返す 】" & vbLf & _
             "  ・セルの書式設定→配置→折り返して全体を表示にチェックを入れる。" & vbLf & _
             "  ・任意の位置で折り返す場合は、その位置で[Alt][Enter]キーを" & vbLf & _
             "   同時に押す。"
    .Labels(3).Text = "【 適正の列幅にするには 】" & vbLf & _
             " 列表示部の右境界線にてダブルクリックを行う。" & vbLf & _
             "  (最長文字列セルに合わせた列幅となります。)"
    .Labels(4).Text = "【 文字位置 】" & vbLf & _
             " ・インテンド(左空白)を使用すると見栄えがよくなります。" & vbLf & _
             " ・数字の場合は、表示形式を数値すると右に空白が出来ます。"
    .Labels(5).Text = "【 セル内の文字列を文字別にフォント設定するには? 】" & vbLf & _
             "  左クリックでの文字範囲選択にてフォント設定が可能となります。"
    .Show
  
  End With

End Sub
Sub 小技97表示形式()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 表示形式をうまく活用するには? 》"
    .Text = String(40, " ")

    .Labels(1).Text = "[書式]→[セル]→[表示形式]の活用"
    .Labels(2).Text = "【 数値 】" & vbLf & _
             "  データセルを数値にするだけで、若干右に空白が出来ます。" & vbLf & _
             "  見栄えにこだわる方にお勧めです。"
    .Labels(3).Text = "【 日付 】" & vbLf & _
             "  沢山の中から、好みの形式に選択出来ます。" & vbLf & _
             "  ユーザー定義にて更に設定可能です。"
    .Labels(4).Text = "【 ユーザー定義 】" & vbLf & _
             " [曜日を付ける]" & vbLf & _
             "  aaaa-火曜日 aaa-火" & vbLf & _
             "  dddd-Tuesday ddd-Tue" & vbLf & _
             "  例) 7/31(水)と表示するには、m/d""(""aaa"")""と入力する。" & vbLf & _
             " [数値単位をつける]" & vbLf & _
             "  0""台"" 0""個"" と入力でOK。" & vbLf & _
             "  文字列の場合は、@を使用します。"
    .Show
  
  End With

End Sub
Sub 小技97シフトコントロール()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 [Shift][Ctrl]キーをうまく活用するには 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 範囲選択 】" & vbLf & _
             "  [ Shift ]キー" & vbLf & _
             "   まず、始点をクリックして[Shift]キーを押しながら終点をクリックするとその" & vbLf & _
             "   囲った範囲が選択されます。" & vbLf & _
             "  [ Ctrl ]キー" & vbLf & _
             "  [Ctrl]キーを押しながらをクリックしていくと、トビトビで範囲選択が行えます。" & vbLf & _
             "  [ データベース範囲の選択 ]" & vbLf & _
             "   データベースの1セルをクリックして、[Shift][Ctrl][*]キーを同時に押すと" & vbLf & _
             "   データベース範囲が選択されます。"
    .Labels(2).Text = "【 エクスプローラのファイル選択も同じ 】" & vbLf & _
             "  [Shift][Ctrl]キーで上記と同じやり方でファイル選択出来ます。" & vbLf & _
             "  ファイル名の少し右から、左クリックにてファイルを囲っても出来ます。"
    .Labels(3).Text = "【 データの各端への移動 】" & vbLf & _
             "  [Ctrl][矢印]キー同時ONにて端セルに移動します。"
    .Labels(4).Text = "【 選択範囲の同時入力 】" & vbLf & _
             "  範囲選択後、入力時[Ctrl][Enter]キーを同時ONにて可能です。" & vbLf & _
             "" & vbLf & _
             "ショートカットキーは他にも多々あります。興味のある方は調べてみて下さい。"
    .Show
  
  End With

End Sub
Sub 小技97関数()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 ちょっとした関数テクニック 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 ""$""をうまく使う 】" & vbLf & _
             " [""$""って(相対と絶対)?]" & vbLf & _
             "  相対…B1セル""=A1""をB2セルにコピーすると""=A2""となります。" & vbLf & _
             "      つまり、行・列に対応した参照となります。" & vbLf & _
             "  絶対…C1セル""=$A$1*B1""をC2セルにコピーすると""=$A$1*B2""となります。" & vbLf & _
             "      つまり、$を付けた部分が固定となります。" & vbLf & _
             "      左の$が列用、右の$が行用です。" & vbLf & _
             " [""$""を簡単に入力には?]" & vbLf & _
             "  (F4)を押していくと$位置が切替っていきます。" & vbLf & _
             " [まとめ]" & vbLf & _
             "  固定部分を見極めて、容易にコピー出来る形にしましょう。"
    .Labels(2).Text = "【 ""IF文""をうまく使う 】" & vbLf & _
             " [""IF文""って?]" & vbLf & _
             "  条件に対して、一致時・不一致時の処理に分ける事が出来ます。" & vbLf & _
             "  例) A1が70以上であれば○、未満であれば×は、" & vbLf & _
             "     =IF(A1>=70,""○"",""×"") となります。" & vbLf & _
             " [ エラーを回避するには ]" & vbLf & _
             "  =A1/B1という数式でB1セルが空白の場合は、#DIV/0!が発生します。" & vbLf & _
             "  あまりセンスが良いと言えないのでIF分で回避しましょう!。" & vbLf & _
             "  =IF(B1>0,A1/B1,"""") でOK。"
    .Labels(3).Text = "【 便利な関数 】" & vbLf & _
             "  ・SUMIF … 条件に一致した合計を計算。" & vbLf & _
             "  ・VLOOKUP … 条件に一致した項目を抽出。" & vbLf & _
             "  詳しくは、ヘルプ等にて。他にも多々有りますが・・・。"
    .Show
  
  End With

End Sub

【20】つづき
Excel  ぴかる  - 02/9/2(月) 21:27 -

引用なし
パスワード
   Sub 小技97条件付き書式()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 条件によって書式変更するには? 》"
    .Text = String(32, " ")

    .Labels(1).Text = "【 条件付き書式を使う 】" & vbLf & _
             " ・セルの値によって、書式設定する事が出来ます。" & vbLf & _
             "" & vbLf & _
             "  例1) 100以上で赤字にする。" & vbLf & _
             "      セルの値が 100以上 赤字に設定" & vbLf & _
             "" & vbLf & _
             "  例2) A1セルが空白ならで白字にする。" & vbLf & _
             "      数式が =$A$1="""" 白字に設定" & vbLf & _
             "" & vbLf & _
             " ・条件設定は、3つまで可能です。" & vbLf & _
             "" & vbLf & _
             "非常に便利な機能です。さあ、使ってみよう!"
    .Show
  
  End With

End Sub
Sub 小技97入力規則()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 入力規則をうまく活用するには? 》"
    .Text = String(32, " ")

    .Labels(1).Text = "データ→入力規則の使用例紹介" & vbLf & _
             ""
    .Labels(2).Text = "【 リスト機能 】" & vbLf & _
             " ・手入力ではなくリストから簡易入力する事が出来ます。" & vbLf & _
             "" & vbLf & _
             "  例) 取引先社名をリストから入力する。" & vbLf & _
             "" & vbLf & _
             "    1. 取引先社名リストを入力シート内に作成する。" & vbLf & _
             "     (少し外れた所に1列にて作成の事!)" & vbLf & _
             "    2. データ→入力規則を選択する。" & vbLf & _
             "    3. 入力値の種類をリストにする。" & vbLf & _
             "    4. 元の値を取引先社名リストセルに合わせる。" & vbLf & _
             "    5. [OK]をクリックにて完了。"
    .Labels(3).Text = "【 整数 】" & vbLf & _
             " 数値入力固定箇所に用います。"
    .Labels(4).Text = "【 入力時メッセージ 】" & vbLf & _
             " 特定のセルに合わせた時にコメント表示が出来ます。" & vbLf & _
             "" & vbLf & _
             "非常に便利な機能です。さあ、使ってみよう!"
    .Show
  
  End With

End Sub
Sub 小技97セルの保護()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 セルの保護を活用するには、 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 数式部に保護をかけ、データ部のみ入力可にするには 】" & vbLf & _
             "  1.行列部左上角クリックもしくは、[Ctrl]+[A]にて全セル選択とする。" & vbLf & _
             "  2.セルの書式設定→保護→ロックのチェックを外す。" & vbLf & _
             "  3.保護をしたい部分(数式部)を選択する。。" & vbLf & _
             "  4.セルの書式設定→保護→ロックにチェックを入れる。" & vbLf & _
             "  5.ツール→保護→シートの保護を行う。" & vbLf & _
             "" & vbLf & _
             "数式の多い入力シートに使うと安心です。"
    .Show
  
  End With

End Sub
Sub 小技97データベース()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 データベースを活用するには 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 データベースって? 】" & vbLf & _
             "  データベースとは、最上段に各種項目があり以下下段は全てデータで" & vbLf & _
             "  構成されているものをいいます。" & vbLf & _
             "   例)在庫管理台帳" & vbLf & _
             "     品名  型式 単価  在庫数  合計" & vbLf & _
             "     ビデオ  A-1  8,000   5   40,000" & vbLf & _
             "     ビデオ  A-2  9,000   3   27,000 " & vbLf & _
             "     テレビ  B-1  20,000   7  140,000" & vbLf & _
             "     テレビ  B-2  50,000   2  100,000" & vbLf & _
             "     カメラ  C-1  30,000   3   60,000" & vbLf & _
             "     カメラ  C-2  50,000   3   15,000"
    .Labels(2).Text = "【 オートフィルタ機能 】" & vbLf & _
             "  抽出したい項目のみを表示することが出来ます。" & vbLf & _
             "   例)テレビのみ、単価10,000以上等の表示切替等" & vbLf & _
             "     オプション機能も充実しており、いろんな事が可能です。"
    .Labels(3).Text = "【 集計機能 】" & vbLf & _
             "  データベース表示に各項目の合計等を追加表示出来ます。" & vbLf & _
             "  アウトライン(行表示切替)も自動で形成されます。"
    .Labels(4).Text = "【 ピボットテーブル 】" & vbLf & _
             "  集計したい条件を配置して、各種集計(合計・平均・個数等)出来ます。" & vbLf & _
             "  非常に便利な機能です。ヘルプ・書籍等を参考にして下さい。"
    .Labels(5).Text = "【 データベース関数 】" & vbLf & _
             "  演算条件を作成し、合計・個数等を求めることが出来ます。" & vbLf & _
             "  少し難しい関数です。ヘルプ・書籍等を参考にして下さい。" & vbLf & _
             "" & vbLf & _
             "業務で集計をされている方は、是非ともこの機能を使ってみて下さい!"
    .Show
  
  End With

End Sub

【21】つづきのつづき
Excel  ぴかる  - 02/9/2(月) 21:28 -

引用なし
パスワード
   Sub 小技97マクロ()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 マクロ 》"
    .Text = String(45, " ")

    .Labels(1).Text = "【 マクロって? 】" & vbLf & _
             "  マクロとは、通常手動で行っている操作を自動で行うプログラムのことです。"
    .Labels(2).Text = "【 どういう時に使うと便利? 】" & vbLf & _
             "  毎日、ひとつのブックで同じ操作を行っている項目があると思います。" & vbLf & _
             "  例えば、データのクリア・印刷等です。このような操作をもっと容易に" & vbLf & _
             "  行いたいと思った方は、是非ともマクロを使うべきです。"
    .Labels(3).Text = "【 どうやって作るの? 】" & vbLf & _
             "  マクロの記録という非常に便利な機能があります。これは、実際の操作を" & vbLf & _
             "  自動的にプログラム化してくれる機能です。マクロって難しいそうと思う" & vbLf & _
             "  前にやってみましょう。"
    .Labels(4).Text = "【 マクロボタンを作ってみよう! 】" & vbLf & _
             "  それでは、シート上にボタンを設置してマクロを登録してみましょう。" & vbLf & _
             "   1.マクロ化したい操作をまとめる。" & vbLf & _
             "   2.ツールバー右の方のボタンをクリックしてシート上に設置する。" & vbLf & _
             "   3.マクロの登録にて記録をオンにする。" & vbLf & _
             "   4.実際の操作を行う。" & vbLf & _
             "   5.ツールバーのボタン2個右横の記録終了をオンにする。" & vbLf & _
             "   6.マクロボタンを押して、動作を確認する。"
    .Labels(5).Text = "【 マクロを編集するには? 】" & vbLf & _
             "  ツールバー右端のVisual Basic Editorにて編集が出来ます。" & vbLf & _
             "  詳しい内容は、書籍等を参考にして下さい。" & vbLf & _
             "" & vbLf & _
             "興味を持たれた方は、トライしてみましょう!"
    .Show
  
  End With

End Sub

Sub 小技97おまけ()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 おまけ 》   "
    .Text = String(40, " ")

    .Labels(1).Text = "【 折れ線グラフの数値の無い部分をつなぐには? 】" & vbLf & _
             "  データ空白部を#N/Aにすると直線でつなぐことが出来ます。"
    .Labels(2).Text = "【 オプションの表示切替機能 】" & vbLf & _
             "  [行列番号][スクロールバー ][枠線][シート名][0表示]等の" & vbLf & _
             "  表示切替が、可能です。見栄えにこだわる方にお勧めです。"
    .Labels(3).Text = "【 検索機能 】" & vbLf & _
             "  [編集]→[検索]" & vbLf & _
             "  検索したい文字入力にて同シート内での検索が可能となります。"
    .Labels(4).Text = "【 置換機能 】" & vbLf & _
             "  [編集]→[置換]" & vbLf & _
             "  変更前の文字と変更後の文字入力にて置換が可能となります。" & vbLf & _
             "   [A1→B1]  検索文字…A  置換文字…B" & vbLf & _
             "   [A_A→AA]  検索文字…_  置換文字…無" & vbLf & _
             "     ↑スペースの削除 "
    .Labels(5).Text = "【 文字列を任意位置にて分割するには 】" & vbLf & _
             "  [データ]→[区切り位置]→[スペースによって・・・]を選択。" & vbLf & _
             "  分割したい位置をマウスにて区切って実行すると分割されます。" & vbLf & _
             "  右セルは空白である事とします。 "
    .Show
  
  End With

End Sub

【22】入力設定
Excel  ぴかる  - 02/9/2(月) 21:29 -

引用なし
パスワード
   Sub 入力設定操作説明()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 入力設定 操作説明 》{ul 0}   "
    .Text = String(40, " ")

    .Labels(1).Text = "{cf 252}【 入力範囲設定 】" & vbLf & _
             "{cf 2} [入力範囲ロック]" & vbLf & _
             "{cf 0}  現在の選択範囲セル(トビトビ範囲可)のみを移動範囲として" & vbLf & _
             "  ロック出来ます。" & vbLf & _
             "{cf 2} [一時解除]" & vbLf & _
             "{cf 0}  一時的にシート保護解除して、編集可状態に出来ます。" & vbLf & _
             "{cf 2} [再設定]" & vbLf & _
             "{cf 0}  再び、前の領域設定に戻します。 ファイルを開いた直後は、" & vbLf & _
             "  解除されているので再設定が必要となります。" & vbLf & _
             "   ( 2002は、保存されているそうです。)"
    .Labels(2).Text = "{cf 252}【 日本語入力 】" & vbLf & _
             "{cf 0}  現在の選択範囲セルを好みの日本語入力状態にロック出来ます。" & vbLf & _
             "  文章を入力するセルには、[オン固定]" & vbLf & _
             "  数値を入力するセルには、[オフ固定]" & vbLf & _
             "   とすると円滑にデータ入力する事が出来ます。"
    .Labels(3).Text = "{cf 252}【 Enter移動 】" & vbLf & _
             "{cf 0}  [Enter]後の移動方向の設定です。"
    .Show
  
  End With

End Sub
Sub 入力設定操作説明97()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 入力設定 操作説明 》"
    .Text = String(40, " ")

    .Labels(1).Text = "【 入力範囲設定 】" & vbLf & _
             " [入力範囲ロック]" & vbLf & _
             "  現在の選択範囲セル(トビトビ範囲可)のみを移動範囲として" & vbLf & _
             "  ロック出来ます。" & vbLf & _
             " [一時解除]" & vbLf & _
             "  一時的にシート保護解除して、編集可状態に出来ます。" & vbLf & _
             " [再設定]" & vbLf & _
             "  再び、前の領域設定に戻します。 ファイルを開いた直後は、" & vbLf & _
             "  解除されているので再設定が必要となります。" & vbLf & _
             "   ( 2002は、保存されているそうです。)"
    .Labels(2).Text = "【 日本語入力 】" & vbLf & _
             "  現在の選択範囲セルを好みの日本語入力状態にロック出来ます。" & vbLf & _
             "  文章を入力するセルには、[オン固定]" & vbLf & _
             "  数値を入力するセルには、[オフ固定]" & vbLf & _
             "   とすると円滑にデータ入力する事が出来ます。"
    .Labels(3).Text = "【 Enter移動 】" & vbLf & _
             "  [Enter]後の移動方向の設定です。"
    .Show
  
  End With

End Sub
Sub 入力範囲ロック()

   ActiveSheet.Unprotect
   Cells.Locked = True
   Selection.Locked = False
   ActiveSheet.EnableSelection = xlUnlockedCells
   ActiveSheet.Protect

End Sub
Sub 一時解除()

   ActiveSheet.Unprotect

End Sub
Sub 再設定()

   ActiveSheet.Unprotect
   ActiveSheet.EnableSelection = xlUnlockedCells
   ActiveSheet.Protect

End Sub
Private Sub 再表示()
 
  Application.CommandBars("PikaBar").Controls("入力設定").Visible = True

End Sub

'ボタンに対応
Private Sub 変換_1()
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   日本語変換 xlIMEModeOn
  End If
End Sub
Private Sub 変換_2()
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   日本語変換 xlIMEModeOff
  End If
End Sub
Private Sub 変換_3()
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
   日本語変換 xlIMEModeNoControl
  End If
End Sub
Private Sub 方向_1()
  移動方向 1
End Sub
Private Sub 方向_2()
  移動方向 2
End Sub
Private Sub 方向_3()
  移動方向 3
End Sub
Private Sub 方向_4()
  移動方向 4
End Sub
Private Sub 方向_5()
  移動方向 5
End Sub
Private Sub 入力設定ON()
  Dim Iflg, II%
  Application.StatusBar = "入力設定"
  Dim myCBpup As CommandBarPopup
  '現在の状況を判定
  Dim vd As Validation
  Set vd = Selection.Validation
  Iflg = -1
  On Error Resume Next
    Iflg = vd.IMEMode
  On Error GoTo 0
  If Iflg = 0 Then Iflg = 3
  Set vd = Nothing
  '
  On Error Resume Next
  Set myCBpup = Application.CommandBars("PikaBar") _
          .Controls("入力設定").Controls(3)
  On Error GoTo 0
  '目玉付加
  If Not myCBpup Is Nothing Then
    For II% = 1 To 3
      With myCBpup.Controls(II%)
        If II% = Iflg Then
          .FaceId = 446
        Else
          .FaceId = 1
          .Enabled = True
        End If
      End With
    Next
  End If
  '
  With Application
    Iflg = 5
    If .MoveAfterReturn = False Then
      Iflg = 5
    Else
      Select Case .MoveAfterReturnDirection
        Case xlDown:   Iflg = 1
        Case xlToRight: Iflg = 2
        Case xlUp:    Iflg = 3
        Case xlToLeft:  Iflg = 4
        Case Else:    Iflg = 5
      End Select
    End If
  End With
  Set myCBpup = Nothing
  On Error Resume Next
  Set myCBpup = Application.CommandBars("PikaBar") _
    .Controls("入力設定").Controls(4)
  On Error GoTo 0
  '目玉付加
  If Not myCBpup Is Nothing Then
    For II% = 1 To 5
      With myCBpup.Controls(II%)
        If II% = Iflg Then
          .FaceId = 446
        Else
          .FaceId = 1
          .Enabled = True
        End If
      End With
    Next
  End If
End Sub
'処理2
Private Sub 日本語変換(arg1 As Long)
  With Selection.Validation
    On Error Resume Next
    .Delete
    On Error GoTo 0
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
    'ここが分岐
    .IMEMode = arg1
  End With
End Sub
'処理3
Private Sub 移動方向(tp As Integer)
  With Application
    If tp = 5 Then
      .MoveAfterReturn = False
    Else
      .MoveAfterReturn = True
      Select Case tp
        Case 1: .MoveAfterReturnDirection = xlDown
        Case 2: .MoveAfterReturnDirection = xlToRight
        Case 3: .MoveAfterReturnDirection = xlUp
        Case 4: .MoveAfterReturnDirection = xlToLeft
      End Select
    End If
  End With
End Sub

【25】文字変換
Excel  ぴかる  - 02/9/2(月) 21:32 -

引用なし
パスワード
   Dim タイトル As String
Dim スタイル As String
Dim メッセージ As String
Dim YESNO As String
Dim 変換数 As Long
Sub 文字変換操作説明()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "{ul 1}{cf 1}《 文字変換 操作説明 》{cf 0}{ul 0}   "
    .Text = String(30, " ")
    .Labels(1).Text = "選択範囲すべてを指定の文字に変換します。"
    .Labels(2).Text = "選択数が2000を越えるとメッセージが出ます。"
    .Labels(3).Text = "マクロにての動作の為、元に戻せません。"
    .Show
  
  End With

End Sub
Sub 文字変換操作説明97()

  With Assistant.NewBalloon
    .BalloonType = msoBalloonTypeBullets
    .Icon = msoIconTip
    .Button = msoButtonSetOK
    .Heading = "《 文字変換 操作説明 》"
    .Text = String(30, " ")
    .Labels(1).Text = "選択範囲すべてを指定の文字に変換します。"
    .Labels(2).Text = "選択数が2000を越えるとメッセージが出ます。"
    .Labels(3).Text = "マクロにての動作の為、元に戻せません。"
    .Show
  
  End With

End Sub
Sub 全角()
     
  Dim セル As Range
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
  
   変換数 = Selection.Count
   If 変換数 > 2000 Then
   メッセージ = "変換数が" & 変換数 & "と多くなっています。" & vbLf & _
          "時間が掛かりますが、実行しますか?。"
   スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
   タイトル = " 【 文字変換 】"
   YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
   If YESNO = vbYes Then
   Else
    MsgBox "キャンセルしました。", vbInformation, タイトル
    Exit Sub
   End If
   End If
  
  
  Application.ScreenUpdating = False  '画面固定
   For Each セル In Selection
    セル = StrConv(セル, vbWide)
   Next

  Set セル = Nothing
  End If
 
End Sub
Sub 半角()
  
  Dim セル As Range
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
  
   変換数 = Selection.Count
   If 変換数 > 2000 Then
   メッセージ = "変換数が" & 変換数 & "と多くなっています。" & vbLf & _
          "時間が掛かりますが、実行しますか?。"
   スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
   タイトル = " 【 文字変換 】"
   YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
   If YESNO = vbYes Then
   Else
    MsgBox "キャンセルしました。", vbInformation, タイトル
    Exit Sub
   End If
   End If
  
  Application.ScreenUpdating = False  '画面固定
   For Each セル In Selection
    セル = StrConv(セル, vbNarrow)
   Next
  End If

  Set セル = Nothing
 
End Sub
Sub 大文字()
  
  Dim セル As Range
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
  
   変換数 = Selection.Count
   If 変換数 > 2000 Then
   メッセージ = "変換数が" & 変換数 & "と多くなっています。" & vbLf & _
          "時間が掛かりますが、実行しますか?。"
   スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
   タイトル = " 【 文字変換 】"
   YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
   If YESNO = vbYes Then
   Else
    MsgBox "キャンセルしました。", vbInformation, タイトル
    Exit Sub
   End If
   End If
  
  Application.ScreenUpdating = False  '画面固定
   For Each セル In Selection
    セル = UCase(セル)
   Next
  End If

  Set セル = Nothing

End Sub
Sub 小文字()
  
  Dim セル As Range
  
  If (ActiveSheet.ProtectContents) Or (TypeName(Selection) <> "Range") Then
   エラーメッセージ
  Else
  
   変換数 = Selection.Count
   If 変換数 > 2000 Then
   メッセージ = "変換数が" & 変換数 & "と多くなっています。" & vbLf & _
          "時間が掛かりますが、実行しますか?。"
   スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
   タイトル = " 【 文字変換 】"
   YESNO = MsgBox(メッセージ, スタイル, タイトル)
  
   If YESNO = vbYes Then
   Else
    MsgBox "キャンセルしました。", vbInformation, タイトル
    Exit Sub
   End If
   End If
  
  Application.ScreenUpdating = False  '画面固定
   For Each セル In Selection
    セル = LCase(セル)
   Next
  End If

  Set セル = Nothing

End Sub

【26】Class1
Excel  ぴかる  - 02/9/3(火) 7:57 -

引用なし
パスワード
   Public WithEvents WBK As Workbook
Public WithEvents App As Application
Private Sub App_SheetActivate(ByVal Sh As Object)
   
  If フラグ <> 1 Then
   If Sh.Type = xlWorksheet And Sh.ProtectContents = False Then
    WBK_SheetSelectionChange ActiveSheet, Selection
   Else
    ShiyoKa False
   End If
  End If
  
End Sub
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
   
   InitializeBook WBook:=Wb
   App_SheetActivate ActiveSheet

End Sub
Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook)
  
   ShiyoKa False

End Sub
Private Sub WBK_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  
   If (ThisWorkbook.Name = "ピカつーる.xla") And (Sh.ProtectContents = False) Then
   ShiyoKa True
   With Application.CommandBars("Cell")
     With .Controls(11)
       If .BuiltIn = False Then .Enabled = True
     End With
   End With
   With Application.CommandBars("オリジナル書式設定")
   If Target.VerticalAlignment = xlBottom Then
    .Controls(12).State = msoButtonDown
   ElseIf Target.VerticalAlignment = xlCenter Then
    .Controls(13).State = msoButtonDown
   ElseIf Target.VerticalAlignment = xlTop Then
    .Controls(14).State = msoButtonDown
   End If
   End With
   Else
   ShiyoKa False
   With Application.CommandBars("Cell")
     With .Controls(11)
       If .BuiltIn = False Then .Enabled = False
     End With
   End With
   End If
  
  If Application.CutCopyMode = xlCopy Then
   With Application.CommandBars("Cell")
     With .Controls(7)
       If .BuiltIn = False Then .Enabled = True
     End With
   End With
  Else
   With Application.CommandBars("Cell")
     With .Controls(7)
       If .BuiltIn = False Then .Enabled = False
     End With
   End With
  End If

End Sub

【27】最後に
Excel  ぴかる  - 02/9/3(火) 12:52 -

引用なし
パスワード
   大変面倒な作業だったと思います。うまく出来たでしょうか?。おひとりでも採用していただけると幸いです。何分、素人が作成したソフトなのでいろんな不具合はあると思われます。ご了承下さい。ご意見ご感想ご質問等ございましたら、下記までよろしくお願いします。

ご意見ご感想、使い方に対する質問は、
 石鹸箱↓にてお願いします。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=83;id=

VBAに関する質問は、
 質問箱↓にてお願いします。答えられる範囲でお答えします。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=159;id=excel

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