Results of 1 - 1 of about 37696 for IF (0.007 sec.)
- [[20081101145236]]
- #score: 1591
- @digest: f2746b18bd91a11267726f1f3aaf98c2
- @id: 40693
- @mdate: 2008-11-03T11:45:53Z
- @size: 26817
- @type: text/plain
- #keywords: arystr (762434), rngstr (310547), ryouyaaa (153028), ryouyaad (121718), 十位 (112896), ryouyaab (109022), ryouyaae (109022), duplicate (96198), 位ca (87886), ryouyaag (87217), ryouyaac (87217), ryouyaaf (87217), 位as (73530), 一h4 (67484), 分十 (67484), 時十 (67484), 一h5 (67484), 一h3 (67484), 一h0 (67484), 一h2 (67484), 一h6 (67484), 一h7 (67484), 一h8 (67484), 一h9 (67484), 一h1 (64439), splitary (58145), 一m1 (45725), 十m5 (45725), 十m0 (45725), 十h1 (45725), 十m1 (45725), 一m0 (45725)
- 『 現在時刻の表示 』（久下久光）
一つのセルに何時何分と（1分毎に動くようにしたい）表示したい ---- =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 = "MS Pゴシック" .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秒")これをどのようにすればいいのでしょうか? （とし） ---- >MsgBox Format(Time, "h時m分s秒")これをどのようにすればいいのでしょうか? 標準モジュールに記述します。 自動更新したいならOnTimeメソッドなどで間欠処理させます。 MsgBoxではなくステータスバーに表示する場合は Application.StatusBar = **** とすればステータスバーに表示します。 いずれにせよ、手動でその時点の時刻を表示するのしか対応してませんので、 自動更新するのは先ほど書きましたようにOnTimeメソッドなどで対応することに ると思います。 (MARBIN) ---- 遅くなりました。試してみます。ありがとうございました。（とし）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200811/20081101145236.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97055 documents and 608272 words.
訪問者：