[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『 現在時刻の表示 』（久下久光）
=NOW()-INT(NOW()) で現在時刻を取得
セルの書式をユーザー定義書式で h"時"m"分"s"秒"
F9キーで手動更新
自動更新したいならVBAになると思います。 (MARBIN)
=NOW() の表示書式を、h"時"mm"分" とすれば良いでしょう。引き算の必要はないと思います。
日経PCの「表計算大会2004」の優秀作品では、マクロを使わず、エクセルを1分ごとに 更新させるワザが使われていました。 これは、外部データとして自分自身のファイルを指定し、さらに、外部データ範囲の プロパティで、「定期的に更新する」にチェックを入れることで、定期的(最小1分 ごと)に再計算させるものです。 Excel2003では動作することは確認しましたが、それ以外のバージョンでは不明です。 (ちゅうねん)
Marbin様・ちゅうねん様ご回答ありがとうございます。＝NOW（）-INT（NOW（））は手動更新ですね。 これですと、目的が達成できませんでした。＝NOW（）は入れることが出来たのですが、自動更新にはなりませんでした。 また、外部データとして自分自身のファイルを指定し、さらに、外部データ範囲のプロパティで、「定期的に更新する」にチェックを 入れることで、定期的(最小1分 ごと)に再計算させるものです。←この意味がわかりません。教えて下さい。宜しくお願い致します。 また、お手数をお掛け致します。
なぜそのようなことをしたいのでしょうか。
エクセルで作業中に現在時刻が知りたいのなら、何もエクセルにそれをさせなくても、 Windowsならタスクバーに表示させることができますし、時刻表示のフリーソフトは いくらでもあるので、それを利用する、ということもできますね。
アホレスすみません。
大いなる無駄？ VBAでデジタル時計を表示します。 PCやエクセルの環境、バージョンに影響を受けます。 うまく表示されなかったり表示が崩れる可能性があります。
Call btn Call shokisettei で初期設定を行い、 Call kousin で更新します。 更新の自動化もできますが、私は手動で行っています。
'ThisWorkbookモジュール Private Sub Workbook_Open() Worksheets(1).Cells.Interior.Color = vbBlack Application.ScreenUpdating = False Call btn Call shokisettei Call kousin Application.ScreenUpdating = True End Sub
'標準モジュール Dim ten As Shape
Sub shokisettei()
Dim yaA As Shape
Dim yaB As Shape
Dim ryouyaAA As Shape
Dim ryouyaAB As Shape
Dim ryouyaAC As Shape
Dim ryouyaAD As Shape
Dim ryouyaAE As Shape
Dim ryouyaAF As Shape
Dim ryouyaAG As Shape
Dim ryouyaBA As Shape
Dim ryouyaBB As Shape
Dim ryouyaBC As Shape
Dim ryouyaBD As Shape
Dim ryouyaBE As Shape
Dim ryouyaBF As Shape
Dim ryouyaBG As Shape
Dim ryouyaCA As Shape
Dim ryouyaCB As Shape
Dim ryouyaCC As Shape
Dim ryouyaCD As Shape
Dim ryouyaCE As Shape
Dim ryouyaCF As Shape
Dim ryouyaCG As Shape
Dim ryouyaDA As Shape
Dim ryouyaDB As Shape
Dim ryouyaDC As Shape
Dim ryouyaDD As Shape
Dim ryouyaDE As Shape
Dim ryouyaDF As Shape
Dim ryouyaDG As Shape
Dim tenA As Shape
Dim tenB As Shape
Dim lt As Single
Dim tp As Single
Dim wd As Single
Dim ht As Single
Dim sp As Object
wd = 50
ht = 10
lt = 120
tp = 0
Set yaA = ActiveSheet.Shapes.AddShape(msoShapePentagon, lt, tp, wd, ht)
With yaA
'.Fill.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 42
.Line.Visible = msoFalse
End With
Set yaB = yaA.Duplicate
yaB.IncrementRotation 180#
yaB.Left = yaA.Left - yaA.Width + 1
yaB.Top = yaA.Top
Set ryouyaAA = ActiveSheet.Shapes.Range(Array(yaA.Name, yaB.Name)).Group
With ryouyaAA
.ScaleWidth 0.97, msoFalse, msoScaleFromTopLeft
.ScaleHeight 2.48, msoFalse, msoScaleFromTopLeft
.Name = "AA"
End With
Set ryouyaAB = ryouyaAA.Duplicate
With ryouyaAB
.Top = .Top + .Width + 5
.Left = ryouyaAA.Left
.Name = "AB"
End With
Set ryouyaAC = ryouyaAB.Duplicate
With ryouyaAC
.Top = .Top + .Width + 5
.Left = ryouyaAB.Left
.Name = "AC"
End With
Set ryouyaAD = ryouyaAA.Duplicate
With ryouyaAD
.IncrementRotation 90#
.Left = ryouyaAA.Left - (ryouyaAA.Width / 2) - 3
.Top = ((ryouyaAA.Top + ryouyaAB.Top) / 2) + (ryouyaAA.Height / 2) - (.Height / 2)
.Name = "AD"
End With
Set ryouyaAE = ryouyaAD.Duplicate
With ryouyaAE
.Top = .Top + .Width + 5
.Left = ryouyaAD.Left
.Name = "AE"
End With
Set ryouyaAF = ryouyaAD.Duplicate
With ryouyaAF
.Left = ryouyaAD.Left + ryouyaAA.Width + 5
.Top = ryouyaAD.Top
.Name = "AF"
End With
Set ryouyaAG = ryouyaAE.Duplicate
With ryouyaAG
.Left = ryouyaAE.Left + ryouyaAA.Width + 5
.Top = ryouyaAE.Top
.Name = "AG"
End With
Set ryouyaBA = ryouyaAA.Duplicate
With ryouyaBA
.Top = ryouyaAA.Top
.Left = ryouyaAA.Left + 150
.Name = "BA"
End With
Set ryouyaBB = ryouyaAB.Duplicate
With ryouyaBB
.Top = ryouyaAB.Top
.Left = ryouyaAB.Left + 150
.Name = "BB"
End With
Set ryouyaBC = ryouyaAC.Duplicate
With ryouyaBC
.Top = ryouyaAC.Top
.Left = ryouyaAC.Left + 150
.Name = "BC"
End With
Set ryouyaBD = ryouyaAD.Duplicate
With ryouyaBD
.Top = ryouyaAD.Top
.Left = ryouyaAD.Left + 150
.Name = "BD"
End With
Set ryouyaBE = ryouyaAE.Duplicate
With ryouyaBE
.Top = ryouyaAE.Top
.Left = ryouyaAE.Left + 150
.Name = "BE"
End With
Set ryouyaBF = ryouyaAF.Duplicate
With ryouyaBF
.Top = ryouyaAF.Top
.Left = ryouyaAF.Left + 150
.Name = "BF"
End With
Set ryouyaBG = ryouyaAG.Duplicate
With ryouyaBG
.Top = ryouyaAG.Top
.Left = ryouyaAG.Left + 150
.Name = "BG"
End With
Set ryouyaCA = ryouyaAA.Duplicate
With ryouyaCA
.Top = ryouyaAA.Top
.Left = ryouyaAA.Left + 300 + 20
.Name = "CA"
End With
Set ryouyaCB = ryouyaAB.Duplicate
With ryouyaCB
.Top = ryouyaAB.Top
.Left = ryouyaAB.Left + 300 + 20
.Name = "CB"
End With
Set ryouyaCC = ryouyaAC.Duplicate
With ryouyaCC
.Top = ryouyaAC.Top
.Left = ryouyaAC.Left + 300 + 20
.Name = "CC"
End With
Set ryouyaCD = ryouyaAD.Duplicate
With ryouyaCD
.Top = ryouyaAD.Top
.Left = ryouyaAD.Left + 300 + 20
.Name = "CD"
End With
Set ryouyaCE = ryouyaAE.Duplicate
With ryouyaCE
.Top = ryouyaAE.Top
.Left = ryouyaAE.Left + 300 + 20
.Name = "CE"
End With
Set ryouyaCF = ryouyaAF.Duplicate
With ryouyaCF
.Top = ryouyaAF.Top
.Left = ryouyaAF.Left + 300 + 20
.Name = "CF"
End With
Set ryouyaCG = ryouyaAG.Duplicate
With ryouyaCG
.Top = ryouyaAG.Top
.Left = ryouyaAG.Left + 300 + 20
.Name = "CG"
End With
Set ryouyaDA = ryouyaAA.Duplicate
With ryouyaDA
.Top = ryouyaAA.Top
.Left = ryouyaAA.Left + 300 + 20 + 150
.Name = "DA"
End With
Set ryouyaDB = ryouyaAB.Duplicate
With ryouyaDB
.Top = ryouyaAB.Top
.Left = ryouyaAB.Left + 300 + 20 + 150
.Name = "DB"
End With
Set ryouyaDC = ryouyaAC.Duplicate
With ryouyaDC
.Top = ryouyaAC.Top
.Left = ryouyaAC.Left + 300 + 20 + 150
.Name = "DC"
End With
Set ryouyaDD = ryouyaAD.Duplicate
With ryouyaDD
.Top = ryouyaAD.Top
.Left = ryouyaAD.Left + 300 + 20 + 150
.Name = "DD"
End With
Set ryouyaDE = ryouyaAE.Duplicate
With ryouyaDE
.Top = ryouyaAE.Top
.Left = ryouyaAE.Left + 300 + 20 + 150
.Name = "DE"
End With
Set ryouyaDF = ryouyaAF.Duplicate
With ryouyaDF
.Top = ryouyaAF.Top
.Left = ryouyaAF.Left + 300 + 20 + 150
.Name = "DF"
End With
Set ryouyaDG = ryouyaAG.Duplicate
With ryouyaDG
.Top = ryouyaAG.Top
.Left = ryouyaAG.Left + 300 + 20 + 150
.Name = "DG"
End With
lt = ((ryouyaBF.Left + ryouyaBF.Width) + ryouyaCD.Left) / 2 - ryouyaAA.Height / 2
tp = (ryouyaBB.Top + ryouyaBA.Top) / 2
wd = ryouyaBF.Height
ht = wd
Set tenA = ActiveSheet.Shapes.AddShape(msoShapeRectangle, lt, tp, wd, ht)
Set tenB = tenA.Duplicate
lt = tenA.Left
tp = (ryouyaBC.Top + ryouyaBB.Top) / 2
With tenB
.Left = lt
.Top = tp
End With
Set ten = ActiveSheet.Shapes.Range(Array(tenA.Name, tenB.Name)).Group
With ten
'.Fill.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 42
.Line.Visible = msoFalse
End With
For Each sp In Worksheets(1).DrawingObjects
If sp.Name <> "SPkousin" And sp.Name <> "SPcls" Then sp.Top = sp.Top + 10
Next
Worksheets(1).DrawingObjects.Visible = False
End Sub
Sub kousin()
Dim i As Integer
Dim mytime As Date
Dim 時十位 As Long
Dim 時一位 As Long
Dim 分十位 As Long
Dim 分一位 As Long
Dim AryStr As String
Dim SplitAry As Variant
Const 一h0 As String = "BA,BC,BD,BE,BF,BG"
Const 一h1 As String = "BF,BG"
Const 一h2 As String = "BA,BB,BC,BE,BF"
Const 一h3 As String = "BA,BB,BC,BF,BG"
Const 一h4 As String = "BB,BD,BF,BG"
Const 一h5 As String = "BA,BB,BC,BD,BG"
Const 一h6 As String = "BA,BB,BC,BD,BE,BG"
Const 一h7 As String = "BA,BF,BG"
Const 一h8 As String = "BA,BB,BC,BD,BE,BF,BG"
Const 一h9 As String = "BA,BB,BC,BD,BF,BG"
Const 十h1 As String = "AF,AG"
Const 十h2 As String = "AA,AB,AC,AE,AF"
Const 一m0 As String = "DA,DC,DD,DE,DF,DG"
Const 一m1 As String = "DF,DG"
Const 一m2 As String = "DA,DB,DC,DE,DF"
Const 一m3 As String = "DA,DB,DC,DF,DG"
Const 一m4 As String = "DB,DD,DF,DG"
Const 一m5 As String = "DA,DB,DC,DD,DG"
Const 一m6 As String = "DA,DB,DC,DD,DE,DG"
Const 一m7 As String = "DA,DF,DG"
Const 一m8 As String = "DA,DB,DC,DD,DE,DF,DG"
Const 一m9 As String = "DA,DB,DC,DD,DF,DG"
Const 十m0 As String = "CA,CC,CD,CE,CF,CG"
Const 十m1 As String = "CF,CG"
Const 十m2 As String = "CA,CB,CC,CE,CF"
Const 十m3 As String = "CA,CB,CC,CF,CG"
Const 十m4 As String = "CB,CD,CF,CG"
Const 十m5 As String = "CA,CB,CC,CD,CG"
Worksheets(1).DrawingObjects.Visible = False
mytime = Now
時十位 = Format(mytime, "h") \ 10
時一位 = Format(mytime, "h") Mod 10
分十位 = Format(mytime, "n") \ 10
分一位 = Format(mytime, "n") Mod 10
Select Case 時十位
Case 0
AryStr = ""
Case 1
AryStr = 十h1
Case 2
AryStr = 十h2
End Select
Select Case 時一位
Case 0
If AryStr = "" Then
AryStr = 一h0
Else
AryStr = AryStr & "," & 一h0
End If
Case 1
If AryStr = "" Then
AryStr = 一h1
Else
AryStr = AryStr & "," & 一h1
End If
Case 2
If AryStr = "" Then
AryStr = 一h2
Else
AryStr = AryStr & "," & 一h2
End If
Case 3
If AryStr = "" Then
AryStr = 一h3
Else
AryStr = AryStr & "," & 一h3
End If
Case 4
If AryStr = "" Then
AryStr = 一h4
Else
AryStr = AryStr & "," & 一h4
End If
Case 5
If AryStr = "" Then
AryStr = 一h5
Else
AryStr = AryStr & "," & 一h5
End If
Case 6
If AryStr = "" Then
AryStr = 一h6
Else
AryStr = AryStr & "," & 一h6
End If
Case 7
If AryStr = "" Then
AryStr = 一h7
Else
AryStr = AryStr & "," & 一h7
End If
Case 8
If AryStr = "" Then
AryStr = 一h8
Else
AryStr = AryStr & "," & 一h8
End If
Case 9
If AryStr = "" Then
AryStr = 一h9
Else
AryStr = AryStr & "," & 一h9
End If
End Select
Select Case 分十位
Case 0
AryStr = AryStr & "," & 十m0
Case 1
AryStr = AryStr & "," & 十m1
Case 2
AryStr = AryStr & "," & 十m2
Case 3
AryStr = AryStr & "," & 十m3
Case 4
AryStr = AryStr & "," & 十m4
Case 5
AryStr = AryStr & "," & 十m5
End Select
Select Case 分一位
Case 0
AryStr = AryStr & "," & 一m0
Case 1
AryStr = AryStr & "," & 一m1
Case 2
AryStr = AryStr & "," & 一m2
Case 3
AryStr = AryStr & "," & 一m3
Case 4
AryStr = AryStr & "," & 一m4
Case 5
AryStr = AryStr & "," & 一m5
Case 6
AryStr = AryStr & "," & 一m6
Case 7
AryStr = AryStr & "," & 一m7
Case 8
AryStr = AryStr & "," & 一m8
Case 9
AryStr = AryStr & "," & 一m9
End Select
SplitAry = Split(AryStr, ",")
Application.ScreenUpdating = False
For i = 0 To UBound(SplitAry)
With Worksheets(1).Shapes(SplitAry(i))
.Visible = True
'.Fill.Visible = msoFalse
'.Fill.ForeColor.SchemeColor = 12
End With
Next i
ten.Visible = True
Worksheets(1).Shapes("SPkousin").Visible = True
Worksheets(1).Shapes("SPcls").Visible = True
Application.ScreenUpdating = True
End Sub
Sub btn()
Dim sp As Shape
Dim kousinbtn As Shape
Dim clsbtn As Shape
Dim lt As Single
Dim tp As Single
Dim wd As Single
Dim ht As Single
Dim i As Integer
Dim mycolor1 As Integer
Dim mycolor2 As Integer
Dim mytxt As String
lt = 0
For i = 1 To 2
wd = 56
ht = 36
tp = (i - 1) * (ht + 10)
Set sp = ActiveSheet.Shapes.AddShape(msoShapeBevel, lt, tp, wd, ht)
With sp
.Fill.Visible = msoTrue
.Fill.Solid
If i = 1 Then
mycolor1 = 42
Else
mycolor1 = 51
End If
.Fill.ForeColor.SchemeColor = mycolor1
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoFalse
If i = 1 Then
mytxt = "更新"
Else
mytxt = "終了"
End If
.TextFrame.Characters.Text = mytxt
If i = 1 Then
.Name = "SPkousin"
.OnAction = "kousin"
Else
.Name = "SPcls"
.OnAction = "cls"
End If
End With
With sp.TextFrame.Characters(Start:=1, Length:=2).Font
.Name = "ＭＳ Ｐゴシック"
.FontStyle = "太字"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
If i = 1 Then
mycolor2 = 5
Else
mycolor2 = 3
End If
.ColorIndex = mycolor2
End With
Next i
End Sub
Sub cls()
ThisWorkbook.Saved = True
If Workbooks.Count = 1 Then
Application.Quit
Else
ThisWorkbook.Close
End If
End Sub
(MARBIN)
こちらはバージョンやPCの環境の影響を受けにくいセルを使うバージョンです。 shokiで初期設定し、kousinで更新します。
Sub shoki()
Dim r As Range
Application.ScreenUpdating = False
Set r = Worksheets(1).Range("B1,d1,E1,F1,H1,J1,L1,M1,N1,P1")
r.ColumnWidth = 0.67
Set r = Worksheets(1).Range("C1,G1,K1,O1")
r.ColumnWidth = 5.57
Set r = Worksheets(1).Range("A1,A7")
r.RowHeight = 13.5
Set r = Worksheets(1).Range("A2,A4,A6")
r.RowHeight = 5.25
Set r = Worksheets(1).Range("A3,A5")
r.RowHeight = 54
Set r = Worksheets(1).Range(Worksheets(1).Range("A1"), Worksheets(1).Range("Q7"))
With r
.Interior.ColorIndex = 34
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 5
End With
End With
Worksheets(1).Range("I3").Value = "■"
Worksheets(1).Range("I5").Value = "■"
Set r = Worksheets(1).Range("I3,I5")
With r
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Color = vbBlue
End With
Call kousin
Application.ScreenUpdating = True
End Sub
Sub kousin()
Dim mytime As Date
Dim 時十位 As Long
Dim 時一位 As Long
Dim 分十位 As Long
Dim 分一位 As Long
Dim RngStr As String
Dim MyRng As Range
Const 一h0 As String = "$F$5,$F$3,$G$2,$H$3,$H$5,$G$6"
Const 一h1 As String = "$H$3,$H$5"
Const 一h2 As String = "$G$2,$H$3,$G$4,$F$5,$G$6"
Const 一h3 As String = "$G$2,$H$3,$G$4,$H$5,$G$6"
Const 一h4 As String = "$F$3,$G$4,$H$3,$H$5"
Const 一h5 As String = "$G$2,$F$3,$G$4,$H$5,$G$6"
Const 一h6 As String = "$G$2,$F$3,$F$5,$G$6,$H$5,$G$4"
Const 一h7 As String = "$G$2,$H$3,$H$5"
Const 一h8 As String = "$G$2,$H$3,$H$5,$F$3,$F$5,$G$6,$G$4"
Const 一h9 As String = "$G$2,$F$3,$H$3,$G$4,$H$5,$G$6"
Const 十h1 As String = "$D$3,$D$5"
Const 十h2 As String = "$C$2,$D$3,$C$4,$B$5,$C$6"
Const 一m0 As String = "$O$2,$N$3,$N$5,$O$6,$P$5,$P$3"
Const 一m1 As String = "$P$3,$P$5"
Const 一m2 As String = "$O$2,$P$3,$O$4,$N$5,$O$6"
Const 一m3 As String = "$O$2,$P$3,$O$4,$P$5,$O$6"
Const 一m4 As String = "$N$3,$O$4,$P$3,$P$5"
Const 一m5 As String = "$O$2,$N$3,$O$4,$P$5,$O$6"
Const 一m6 As String = "$O$2,$N$3,$N$5,$O$6,$P$5,$O$4"
Const 一m7 As String = "$O$2,$P$3,$P$5"
Const 一m8 As String = "$O$2,$P$3,$P$5,$N$3,$N$5,$O$6,$O$4"
Const 一m9 As String = "$O$2,$N$3,$O$4,$P$3,$P$5,$O$6"
Const 十m0 As String = "$K$2,$J$3,$J$5,$K$6,$L$5,$L$3"
Const 十m1 As String = "$L$3,$L$5"
Const 十m2 As String = "$K$2,$L$3,$K$4,$J$5,$K$6"
Const 十m3 As String = "$K$2,$L$3,$K$4,$L$5,$K$6"
Const 十m4 As String = "$J$3,$K$4,$L$3,$L$5"
Const 十m5 As String = "$K$2,$J$3,$K$4,$L$5,$K$6"
Application.ScreenUpdating = False
Range("B2:P6").Interior.ColorIndex = 34
mytime = Now
時十位 = Format(mytime, "h") \ 10
時一位 = Format(mytime, "h") Mod 10
分十位 = Format(mytime, "n") \ 10
分一位 = Format(mytime, "n") Mod 10
Select Case 時十位
Case 0
RngStr = ""
Case 1
RngStr = 十h1
Case 2
RngStr = 十h2
End Select
Select Case 時一位
Case 0
If RngStr = "" Then
RngStr = 一h0
Else
RngStr = RngStr & "," & 一h0
End If
Case 1
If RngStr = "" Then
RngStr = 一h1
Else
RngStr = RngStr & "," & 一h1
End If
Case 2
If RngStr = "" Then
RngStr = 一h2
Else
RngStr = RngStr & "," & 一h2
End If
Case 3
If RngStr = "" Then
RngStr = 一h3
Else
RngStr = RngStr & "," & 一h3
End If
Case 4
If RngStr = "" Then
RngStr = 一h4
Else
RngStr = RngStr & "," & 一h4
End If
Case 5
If RngStr = "" Then
RngStr = 一h5
Else
RngStr = RngStr & "," & 一h5
End If
Case 6
If RngStr = "" Then
RngStr = 一h6
Else
RngStr = RngStr & "," & 一h6
End If
Case 7
If RngStr = "" Then
RngStr = 一h7
Else
RngStr = RngStr & "," & 一h7
End If
Case 8
If RngStr = "" Then
RngStr = 一h8
Else
RngStr = RngStr & "," & 一h8
End If
Case 9
If RngStr = "" Then
RngStr = 一h9
Else
RngStr = RngStr & "," & 一h9
End If
End Select
Select Case 分十位
Case 0
RngStr = RngStr & "," & 十m0
Case 1
RngStr = RngStr & "," & 十m1
Case 2
RngStr = RngStr & "," & 十m2
Case 3
RngStr = RngStr & "," & 十m3
Case 4
RngStr = RngStr & "," & 十m4
Case 5
RngStr = RngStr & "," & 十m5
End Select
Select Case 分一位
Case 0
RngStr = RngStr & "," & 一m0
Case 1
RngStr = RngStr & "," & 一m1
Case 2
RngStr = RngStr & "," & 一m2
Case 3
RngStr = RngStr & "," & 一m3
Case 4
RngStr = RngStr & "," & 一m4
Case 5
RngStr = RngStr & "," & 一m5
Case 6
RngStr = RngStr & "," & 一m6
Case 7
RngStr = RngStr & "," & 一m7
Case 8
RngStr = RngStr & "," & 一m8
Case 9
RngStr = RngStr & "," & 一m9
End Select
Set MyRng = Range(RngStr)
MyRng.Interior.ColorIndex = 5
Application.ScreenUpdating = True
End Sub
(MARBIN)
最後はユーザーフォーム版です。
ブック起動時にユーザーフォームを表示するようにしておきます。 更新は同じく標準モジュールのkousinで行います。
'ユーザーフォーム
Private Sub UserForm_Initialize()
Dim mycontrol As msForms.Label
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Me.Caption = "XL-CLOCK"
Me.BackColor = vbWhite
cnt = 0
'-
For i = 1 To 4
For j = 1 To 3
cnt = cnt + 1
Set mycontrol = Me.Controls.Add("Forms.Label.1")
With mycontrol
If i > 2 Then
.Left = (i - 3) * 48.05 + 120
Else
.Left = (i - 1) * 48.05 + 12
End If
.Top = (j - 1) * 30 + 6
.Height = 6
.Width = 30
.Caption = ""
.BackColor = &HFFFFFF
End With
Next j
Next i
'|
For i = 1 To 8
For j = 1 To 2
cnt = cnt + 1
Set mycontrol = Me.Controls.Add("Forms.Label.1")
With mycontrol
If i > 4 Then
.Left = ((i + 1) \ 2 - 1) * 48.05 + 17.9 + ((i + 1) Mod 2) * 36
Else
.Left = ((i + 1) \ 2 - 1) * 48.05 + 6 + ((i + 1) Mod 2) * 36
End If
.Top = (j - 1) * 30 + 12
.Height = 24
.Width = 6
.Caption = ""
.BackColor = &HFFFFFF
End With
Next j
Next i
'■
For i = 1 To 2
cnt = cnt + 1
Set mycontrol = Me.Controls.Add("Forms.Label.1")
With mycontrol
.Top = (i - 1) * 30 + 18
.Left = 102
.Height = 6
.Width = 6
.Caption = ""
.BackColor = &HFF0000
End With
Next i
Call kousin
End Sub
'標準モジュール
Sub kousin()
Dim i As Integer
Dim mytime As Date
Dim 時十位 As Long
Dim 時一位 As Long
Dim 分十位 As Long
Dim 分一位 As Long
Dim AryStr As String
Dim SplitAry As Variant
Const 一h0 As String = "4,6,17,18,19,20"
Const 一h1 As String = "19,20"
Const 一h2 As String = "4,5,6,18,19"
Const 一h3 As String = "4,5,6,19,20"
Const 一h4 As String = "5,17,19,20"
Const 一h5 As String = "4,5,6,17,20"
Const 一h6 As String = "4,5,6,17,18,20"
Const 一h7 As String = "4,19,20"
Const 一h8 As String = "4,5,6,17,18,19,20"
Const 一h9 As String = "4,5,6,17,19,20"
Const 十h1 As String = "15,16"
Const 十h2 As String = "1,2,3,14,15"
Const 一m0 As String = "10,12,25,26,27,28"
Const 一m1 As String = "27,28"
Const 一m2 As String = "10,11,12,26,27"
Const 一m3 As String = "10,11,12,27,28"
Const 一m4 As String = "11,25,27,28"
Const 一m5 As String = "10,11,12,25,28"
Const 一m6 As String = "10,11,12,25,26,28"
Const 一m7 As String = "10,27,28"
Const 一m8 As String = "10,11,12,25,26,27,28"
Const 一m9 As String = "10,11,12,25,27,28"
Const 十m0 As String = "7,9,21,22,23,24"
Const 十m1 As String = "23,24"
Const 十m2 As String = "7,8,9,22,23"
Const 十m3 As String = "7,8,9,23,24"
Const 十m4 As String = "8,21,23,24"
Const 十m5 As String = "7,8,9,21,24"
For i = 1 To 28
UserForm1.Controls("Label" & i).BackColor = &HFFFFFF
Next i
mytime = Now
時十位 = Format(mytime, "h") \ 10
時一位 = Format(mytime, "h") Mod 10
分十位 = Format(mytime, "n") \ 10
分一位 = Format(mytime, "n") Mod 10
Select Case 時十位
Case 0
AryStr = ""
Case 1
AryStr = 十h1
Case 2
AryStr = 十h2
End Select
Select Case 時一位
Case 0
If AryStr = "" Then
AryStr = 一h0
Else
AryStr = AryStr & "," & 一h0
End If
Case 1
If AryStr = "" Then
AryStr = 一h1
Else
AryStr = AryStr & "," & 一h1
End If
Case 2
If AryStr = "" Then
AryStr = 一h2
Else
AryStr = AryStr & "," & 一h2
End If
Case 3
If AryStr = "" Then
AryStr = 一h3
Else
AryStr = AryStr & "," & 一h3
End If
Case 4
If AryStr = "" Then
AryStr = 一h4
Else
AryStr = AryStr & "," & 一h4
End If
Case 5
If AryStr = "" Then
AryStr = 一h5
Else
AryStr = AryStr & "," & 一h5
End If
Case 6
If AryStr = "" Then
AryStr = 一h6
Else
AryStr = AryStr & "," & 一h6
End If
Case 7
If AryStr = "" Then
AryStr = 一h7
Else
AryStr = AryStr & "," & 一h7
End If
Case 8
If AryStr = "" Then
AryStr = 一h8
Else
AryStr = AryStr & "," & 一h8
End If
Case 9
If AryStr = "" Then
AryStr = 一h9
Else
AryStr = AryStr & "," & 一h9
End If
End Select
Select Case 分十位
Case 0
AryStr = AryStr & "," & 十m0
Case 1
AryStr = AryStr & "," & 十m1
Case 2
AryStr = AryStr & "," & 十m2
Case 3
AryStr = AryStr & "," & 十m3
Case 4
AryStr = AryStr & "," & 十m4
Case 5
AryStr = AryStr & "," & 十m5
End Select
Select Case 分一位
Case 0
AryStr = AryStr & "," & 一m0
Case 1
AryStr = AryStr & "," & 一m1
Case 2
AryStr = AryStr & "," & 一m2
Case 3
AryStr = AryStr & "," & 一m3
Case 4
AryStr = AryStr & "," & 一m4
Case 5
AryStr = AryStr & "," & 一m5
Case 6
AryStr = AryStr & "," & 一m6
Case 7
AryStr = AryStr & "," & 一m7
Case 8
AryStr = AryStr & "," & 一m8
Case 9
AryStr = AryStr & "," & 一m9
End Select
SplitAry = Split(AryStr, ",")
For i = 0 To UBound(SplitAry)
UserForm1.Controls("Label" & SplitAry(i)).BackColor = &HFF0000
Next i
End Sub
(MARBIN)
延々とアホなレスを続けてきましたが、VBAで現在時刻を表示するのは ↓だけでいけます。
MsgBox Format(Time, "h時m分s秒") (MARBIN)
>MsgBox Format(Time, "h時m分s秒")これをどのようにすればいいのでしょうか？
標準モジュールに記述します。 自動更新したいならOnTimeメソッドなどで間欠処理させます。 MsgBoxではなくステータスバーに表示する場合は Application.StatusBar = **** とすればステータスバーに表示します。 いずれにせよ、手動でその時点の時刻を表示するのしか対応してませんので、 自動更新するのは先ほど書きましたようにOnTimeメソッドなどで対応することに ると思います。 (MARBIN)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.