| |
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 = "ＭＳ Ｐゴシック"
.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
|
|
ぴかる
- 02/9/2(月) 21:03 -
![[未読]](./data/FAQ/image/read_icon.gif){kind=icon}
