Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


74467 / 76738 ←次へ | 前へ→

【6737】修正個所を教えてください(期間計算)
質問  m070504  - 03/7/30(水) 12:31 -

引用なし
パスワード
   勤務期間を計算するに当たって、お願いがあります。
フォームに、採用日・退職日を入力し、
コマンドボタンを押すと、期間が表示されるようにしたいと思いました。
(採用日と退職日も含まれるようにする)

下記のVBAをネット上で見つけたのですが、
打ち込みましたところ、エラーが出て、計算されません。
私の解読力では、「picture1.cls」の意味も分かりませんでした。
フォームは、採用日・退職日・期間表示場所をtextboxにし、
それぞれ、Text1,Text2,picture1と名前を変えました。

どのようにすれば、動きますでしょうか。
何分初心者なので、よろしくお願いいたします。

Private Sub Command2_Click()
 Dim sd As String, ed As String
  Dim y As Integer, m As Integer, d As Integer
  
  sd = Text1.Text
  ed = Text1.Text
  
  Call kikan2(sd, ed, y, m, d)
  
  picture1.cls
  picture1.Print y; "年"; m; "月"; d; "日"
  
End Sub

Private Sub kikan2(sd As String, ed As String, y As Integer, m As Integer, d As Integer)
Dim sdv As Variant, edv As Variant
Dim sdy As Integer, sdm As Integer, sdd As Integer
Dim edy As Integer, edm As Integer, edd As Integer
Dim sd2 As String, ed2 As String
Dim sn As Integer, sn2 As Integer
Dim en As Integer
Dim sn3 As Integer

If sd = "" Or ed = "" Then Exit Sub
sdv = DateValue(sd): edv = DateValue(ed)
If sdv > edv Then Exit Sub

sdy = Year(sdv): sdm = Month(sdv): sdd = Day(sdv)
edy = Year(edv): edm = Month(edv): sdd = Day(edv)
If sdy = 0 And sdm = 0 And sdd = 0 Then Exit Sub
If edy = 0 And edm = 0 And edd = 0 Then Exit Sub
sn = Day(DateValue(DateSerial(sdy, sdm + 1, 1)) - 1)
sn2 = sn - sdd + 1
sn3 = DateDiff("d", sd, DateSerial(sdy, sdm + 1, sdd))

en = Day(DateValue(ed) + 1)

y = edy - sdy
m = edm - sdm
d = sn2 + edd

If sdd = 1 Then
d = d - sn2
Else
  If y = 1 And m = 0 Then
  d = edd - sdd + 1
  Exit Sub
  End If
  m = m - 1
End If

If en = 1 Then
d = d - edd
m = m + 1
End If

If d > sn3 Then
d = d - sn3
m = m + 1
End If

If m < 0 Then
m = 12 + m
y = y - 1
End If

If m = 12 Then
m = m - 12
y = y + 1
End If

0 hits

【6737】修正個所を教えてください(期間計算) m070504 03/7/30(水) 12:31 質問
【6757】Re:修正個所を教えてください(期間計算) 角田 03/7/31(木) 16:00 回答

74467 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free