目安箱 IV

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

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

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

【4】アドインファイルにてツールバーを表示するには、[ソフト紹介] ぴかる 02/9/2(月) 20:42 Excel[未読]

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

【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

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