Excel VBA質問箱 IV

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

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


4818 / 13646 ツリー ←次へ | 前へ→

【54189】フォームを用いて値をシートに記入するには にしもり 08/2/28(木) 18:43 質問[未読]
【54195】Re:フォームを用いて値をシートに記入する... ハチ 08/2/29(金) 9:29 発言[未読]
【54196】Re:フォームを用いて値をシートに記入する... にしもり 08/2/29(金) 10:18 質問[未読]
【54197】Re:フォームを用いて値をシートに記入する... ハチ 08/2/29(金) 10:41 発言[未読]
【54198】Re:フォームを用いて値をシートに記入する... にしもり 08/2/29(金) 11:09 質問[未読]
【54200】Re:フォームを用いて値をシートに記入する... にしもり 08/2/29(金) 12:02 質問[未読]
【54201】Re:フォームを用いて値をシートに記入する... ハチ 08/2/29(金) 12:55 発言[未読]
【54213】Re:フォームを用いて値をシートに記入する... にしもり 08/2/29(金) 19:19 発言[未読]
【54232】Re:フォームを用いて値をシートに記入する... にしもり 08/3/1(土) 15:21 質問[未読]
【54233】Re:フォームを用いて値をシートに記入する... にしもり 08/3/1(土) 15:51 質問[未読]
【54243】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 12:58 発言[未読]
【54244】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 13:24 質問[未読]
【54245】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 13:57 質問[未読]
【54249】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 14:08 発言[未読]
【54246】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 13:58 発言[未読]
【54247】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 14:03 お礼[未読]
【54248】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 14:07 発言[未読]
【54260】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 16:13 発言[未読]
【54262】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 16:26 質問[未読]
【54264】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 16:31 発言[未読]
【54266】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 16:44 お礼[未読]
【54268】Re:フォームを用いて値をシートに記入する... かみちゃん 08/3/2(日) 16:55 発言[未読]
【54276】Re:フォームを用いて値をシートに記入する... にしもり 08/3/2(日) 18:09 お礼[未読]

【54189】フォームを用いて値をシートに記入するに...
質問  にしもり  - 08/2/28(木) 18:43 -

引用なし
パスワード
   こんにちは。
次のようなことをしたいです。

アクティヴシートのB列の(3行目以下の)n行をダブルクリックすると、自動的に同じブックのシートhistoryの空白行をみつけてCnm,Pnm,Mnm,Tnmが転記される。(1)
(1)は自力でできました。
↓↓↓
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Cnm As String
Dim Pnm As String
Dim Mnm As String
Dim Tnm As String
Dim ws1 As Worksheet
Dim i As Long
  
  If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
  
    With Target
      Cnm = .Offset(, -1).Value
      Pnm = .Offset(0, 0).Value
      Mnm = .Offset(, 3).Value
      Tnm = .Offset(, 5).Value
    End With
  
    Set ws1 = Worksheets("history")
    For i = 5 To ws1.Range("B65535").End(xlDown).Row
      If IsEmpty(ws1.Cells(i, 2).Value) Then
        ws1.Cells(i, 2).Value = Cnm
        ws1.Cells(i, 3).Value = Pnm
        ws1.Cells(i, 4).Value = Mnm
        ws1.Cells(i, 9).Value = Tnm
        Exit For
      End If
    Next i
    
    Cancel = True
 
  End If

End Sub


ひきつづいて、以下のことをしたいです。(2)

フォームが表出され、そのフォームには以下を入力するようになっている。
Dateをyyyy/mm/ddで入力し、
Time(From)をhh:mm(15分単位)でプルダウンで選び、
Time(To)をhh:mm(15分単位)でプルダウンで選び、
Placeを任意の文字列で入力し、
Notesを任意の文字列で入力し、
enterを押す。

そのとき、
Dateはws1.Cells(i, 5).Valueに、
Time(From)はws1.Cells(i, 6).Valueに、
Time(To)はws1.Cells(i, 7).Valueに、
Hoursというのがws1.Cells(i, 8).Valueに、
Placeはws1.Cells(i, 10).Valueに、
Noteseはws1.Cells(i, 11).Valueに、
転記されるようにしたい。
転記と同時にフォームは画面から消したい。
Hoursは、たとえばTime(From)が09:15で、Time(To)が10:00なら、0.75としたい。
そしてsaveするとき、作業当日の日付けをシートhistoryのセルk3に書き込みたい。

以上ですが(2)がまったくできていません。
このような場合にユーザーフォームを使うのでしょうか。
また、Hoursの計算式が難しいです。
どなたかアドバイスよろしくおねがいします。

【54195】Re:フォームを用いて値をシートに記入す...
発言  ハチ  - 08/2/29(金) 9:29 -

引用なし
パスワード
   ▼にしもり さん:
>Hoursは、たとえばTime(From)が09:15で、Time(To)が10:00なら、0.75としたい。
>そしてsaveするとき、作業当日の日付けをシートhistoryのセルk3に書き込みたい。

この2つだけ。
Hoursはシリアル値を計算して、×24 すれば良いです。
日付をまたぐことがある(たとえば、23:00〜02:00など)があるなら、
もうすこし考慮が必要です。
Date型に変換できるか のチェックはご自分で入れてみてください。
historyに入れる日付は Now を変換すればすぐできそうです。

Option Explicit

Sub Test()
  Dim From_Str As String
  Dim To_Str As String
  Dim Hours As Double
  
  From_Str = "10:15"
  To_Str = "11:00"
  
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  MsgBox Hours
  MsgBox Format(Now(), "yyyy/mm/dd")
End Sub

【54196】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/2/29(金) 10:18 -

引用なし
パスワード
   ▼ハチ さん:
ありがとうございます。
その2つはアドバイス通りすすめてみます。

ところで、市販の教本に年月日を抽出するテクニックがありました。
やはりユーザーフォーム使用です。

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
  カレンダーの日付をセルにセットする
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
  カレンダーの日付をセルにセットする
End Sub

Private Sub カレンダーの日付をセルにセットする()
  ws1.Cells(i, 5).Value = Calendar1.Value

End Sub

Private Sub CommandButton1_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

これをベースしようとおもいます。
ですが、未熟ゆえわからないことがあります。
アクティヴシートのB列セルをダブルクリックでシートhistoryに転記したしたあと、それにひき続きuserformをshowしたいのですができません。
どうすればできるでしょうか。

【54197】Re:フォームを用いて値をシートに記入す...
発言  ハチ  - 08/2/29(金) 10:41 -

引用なし
パスワード
   ▼にしもり さん:

>アクティヴシートのB列セルをダブルクリックでシートhistoryに転記したしたあと、それにひき続きuserformをshowしたいのですができません。
>どうすればできるでしょうか。

これは、複数のシートのイベントとして使いたい という意味ですか?
そうであれば、
ThisWorkbookモジュールの
Private Sub Workbook_SheetBeforeDoubleClickイベントにすれば、良いと思います。

質問の意味を履き違えていたらゴメンナサイ

【54198】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/2/29(金) 11:09 -

引用なし
パスワード
   ▼ハチ さん:
こちらこそすみません。
シートは、最初にアクティブになっているシートと、Historyという名のシートがあります。
アクティブシートには、Historyシートに転記したい項目があります。(Cnm とかPnmとか)
これはThisWorkbookモジュールのダブルクrクイベントできることがわかりました。
ですが、やりたいことはさらにあって、最初のアクティブシートに無い情報(DateとかTime(from),Time(To)とか)をもHistoryシートに追記したいのです。
その際ThisWorkbookモジュールに引き続いて、スムースにuserformを起動させるにはどうすればいいかわかりません。

【54200】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/2/29(金) 12:02 -

引用なし
パスワード
   ▼ハチ さん:
イメージとしてはこんな感じでしょうか。
わかってなくて本当にすみません。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim Cnm As String
Dim Pnm As String
Dim Mnm As String
Dim Tnm As String
Dim ws1 As Worksheet
Dim i As Long
  
  If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
  
    With Target
      Cnm = .Offset(, -1).Value
      Pnm = .Offset(0, 0).Value
      Mnm = .Offset(, 3).Value
      Tnm = .Offset(, 5).Value
    End With
  
    Set ws1 = Worksheets("history")
    For i = 5 To ws1.Range("B65535").End(xlDown).Row
      If IsEmpty(ws1.Cells(i, 2).Value) Then
        ws1.Cells(i, 2).Value = Cnm
        ws1.Cells(i, 3).Value = Pnm
        ws1.Cells(i, 4).Value = Mnm
        ws1.Cells(i, 9).Value = Tnm

    Goto Eline

        Exit For
      End If
    Next i
    
    Cancel = True
 
  End If

Eline:
Private Sub UserForm_Initialize()
  Calendar1.Value = Date
  カレンダーの日付をセルにセットする
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
  カレンダーの日付をセルにセットする
End Sub

Private Sub カレンダーの日付をセルにセットする()
  ws1.Cells(i, 5).Value = Calendar1.Value

End Sub

Private Sub CommandButton1_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub


End Sub

【54201】Re:フォームを用いて値をシートに記入す...
発言  ハチ  - 08/2/29(金) 12:55 -

引用なし
パスワード
   ▼にしもり さん:

UserFormのイベントは、UserFormモジュールに書かないと動きませんよ。
そのあたりを詳しく解説しているサイトを探してみてください。
掲示板で回答するよりも図入りでわかりやすいと思います。

>
>Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
>
>Dim Cnm As String
>Dim Pnm As String
>Dim Mnm As String
>Dim Tnm As String
>Dim ws1 As Worksheet
>Dim i As Long
>  
>  If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
>  
>    With Target
>      Cnm = .Offset(, -1).Value
>      Pnm = .Offset(0, 0).Value
>      Mnm = .Offset(, 3).Value
>      Tnm = .Offset(, 5).Value
>    End With
>  
>    Set ws1 = Worksheets("history")
>    For i = 5 To ws1.Range("B65535").End(xlDown).Row
>      If IsEmpty(ws1.Cells(i, 2).Value) Then
>        ws1.Cells(i, 2).Value = Cnm
>        ws1.Cells(i, 3).Value = Pnm
>        ws1.Cells(i, 4).Value = Mnm
>        ws1.Cells(i, 9).Value = Tnm
>
>    Goto Eline
>
>        Exit For
>      End If
>    Next i
>    
>    Cancel = True
> 
>  End If

   UserForm1.Show
End Sub


>'Eline:

'ここから↓はUserFormモジュールに書く

>Private Sub UserForm_Initialize()
>  Calendar1.Value = Date
>  カレンダーの日付をセルにセットする
>End Sub
>
>Private Sub Calendar1_Click()
>  TextBox1.Value = Calendar1.Value
>  カレンダーの日付をセルにセットする
>End Sub
>
>Private Sub カレンダーの日付をセルにセットする()
>  ws1.Cells(i, 5).Value = Calendar1.Value
>
>End Sub
>
>Private Sub CommandButton1_Click()
>  Unload UserForm1
>End Sub
>
>Private Sub UserForm_Deactivate()
>  Unload UserForm1
>End Sub
>
>End Sub

【54213】Re:フォームを用いて値をシートに記入す...
発言  にしもり  - 08/2/29(金) 19:19 -

引用なし
パスワード
   ▼ハチ さん:
>UserFormのイベントは、UserFormモジュールに書かないと動きませんよ。
ありがとうございます。
すみません、基礎ができていません。

【54232】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/3/1(土) 15:21 -

引用なし
パスワード
   ユーザーフォームを呼び出したいので下記のように記述しました。
ところが実行すると「実行時エラー424 オブジェクトが必要です」と出て、
UserForm1.Showが黄色になってしまいます。
Internetで調べても該当がなかなかありません。
どこを直せばばよいか どなたか御教えねがえないでしょうか。
ユーザーフォームのプロパティを確認しましたがオブジェクト名=UserForm1です。


Dim Mnm As String
Dim Tnm As String
Dim ws1 As Worksheet
Dim i As Long

  If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
  
    With Target
      Cnm = .Offset(, -1).Value
      Pnm = .Offset(0, 0).Value
      Mnm = .Offset(, 3).Value
      Tnm = .Offset(, 5).Value
    End With
  
    Set ws1 = Worksheets("history")
    For i = 5 To ws1.Range("B65535").End(xlDown).Row
      If IsEmpty(ws1.Cells(i, 2).Value) Then
        ws1.Cells(i, 2).Value = Cnm
        ws1.Cells(i, 3).Value = Pnm
        ws1.Cells(i, 4).Value = Mnm
        ws1.Cells(i, 9).Value = Tnm
        
        UserForm1.Show
        
        Exit For
      End If
    Next i
    
    Cancel = True
 
  End If

End Sub

【54233】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/3/1(土) 15:51 -

引用なし
パスワード
   Private Sub UserForm_Initialize()
  Calendar1.Value = Date
  カレンダーの日付をセルにセットする
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
  カレンダーの日付をセルにセットする
End Sub

Private Sub カレンダーの日付をセルにセットする()
  ' ws1.Cells(i, 5).Value = Calendar1.Value
End Sub

Private Sub CommandButton1_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

ユーザーフォームのコードをいじり、上記のように
ws1.Cells(i, 5).Value = Calendar1.Value
の行をコメントにしたらユーザーフォームが表出されるところまではきました。
要はCalendar1.Valueを、シート「ヒストリー」の、作業中の行の5列目に転記したいのです。
それができません。
いい方法がないかどなたか御教えお願いないでしょうか。

【54243】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 12:58 -

引用なし
パスワード
   こんにちは。かみちゃん です。

横から失礼します。
レスがなかなかつきませんね。

>ユーザーフォームのコードをいじり、上記のように
>ws1.Cells(i, 5).Value = Calendar1.Value
>の行をコメントにしたらユーザーフォームが表出されるところまではきました。
>要はCalendar1.Valueを、シート「ヒストリー」の、作業中の行の5列目に転記したいのです。

UserFormモジュールの先頭に、
Option Explicit
をつけて、変数の宣言を強制的にするように心がけてみませんか?

そうすると、変数の宣言方法に問題があることがわかると思います。

ws1.Cells(i, 5).Value
の変数ws1 と i は何をどこで設定していますか?

シートイベントが設定されているモジュール内で、
Dim ws1 As Worksheet
Dim i As Long
があって、それを利用したいならば、シートモジュール内の宣言をせずに、
標準モジュールで、
Public ws1 As Worksheet
Public i As Long
と宣言して、利用するようにできませんか?

にしもりさんくらいのレベルになると、
Option Explicit
をどのモジュールの先頭に記述することを心がけることで、この手の疑問は、
すぐに解決されると思います。
なお、どのモジュールに記述しなくても、
VBEの「ツール」−「オプション」の「編集」タブの「変数の宣言を強制する」に
チェックをつけておくというのもアリです。

【54244】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/3/2(日) 13:24 -

引用なし
パスワード
   ▼かみちゃん さん:
アドバイスまことにありがとうございます。

>Option Explicit
>をつけて、変数の宣言を強制的にするように心がけてみませんか?
宣言セクションに記入しました。

>標準モジュールで、
>Public ws1 As Worksheet
>Public i As Long
>と宣言して、利用するようにできませんか?
シートをダブルクリックをするだけで転記されるように、と思いシートモジュールに、
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
と記述しました。
わたしの疑問は、標準モジュールにするとこの行の記述も大きく変わってしまわないでしょうか、ということです。


>にしもりさんくらいのレベルになると、
とんでもありません、でもお世辞でもうれしく存じます。

【54245】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/3/2(日) 13:57 -

引用なし
パスワード
   ワークシートモジュールを標準モジュールに変更するには、
Sub Worksheet_BeforeDoubleClick(xxxxxxx)を止めて
Sub Test1(xxxxxxx) にすればよいでしょうか。
以下のようにかえたら保存(コンパイル)はできたものの、Cnmなどが転記されず、また、ユーザーフォームがで表出されなくなってしまいました。
なお転記元のシートはoverviewといいます。

Option Explicit
Dim Cnm As String
Dim Pnm As String
Dim Mnm As String
Dim Tnm As String
Public ws1 As Worksheet
Public i As Long


'Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  ←これを止めて、
Sub Test1(ByVal Target As Range, Cancel As Boolean) ←こうでしょうか
  Activate.Worksheet("overview")
  
  If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
  
    With Target
      Cnm = .Offset(, -1).Value
      Pnm = .Offset(0, 0).Value
      Mnm = .Offset(, 3).Value
      Tnm = .Offset(, 5).Value
    End With
  
    Set ws1 = Worksheets("history")
    For i = 5 To ws1.Range("B65535").End(xlDown).Row
      If IsEmpty(ws1.Cells(i, 2).Value) Then
        ws1.Cells(i, 2).Value = Cnm
        ws1.Cells(i, 3).Value = Pnm
        ws1.Cells(i, 4).Value = Mnm
        ws1.Cells(i, 9).Value = Tnm
        
        UserForm1.Show
              
        Exit For
      End If
    Next i
    
    Cancel = True
 
  End If

End Sub

【54246】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 13:58 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>シートをダブルクリックをするだけで転記されるように、と思いシートモジュールに、
>Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
>と記述しました。
>わたしの疑問は、標準モジュールにするとこの行の記述も大きく変わってしまわないでしょうか、ということです。

このスレッドを先頭から読み直してみましたが、現在、何がしたいのかわかりません。
シートイベントで起きる動作を標準モジュールに記述したいのですか?

次から次へと質問されるのは、いいのですが、追加質問があるならば、「削除」キーを
設定されているようですから、質問内容を削除し、投稿しなおしてはいかがですか?
スレッドの分裂が起きそうで、かえって混乱しそうです。

【54247】Re:フォームを用いて値をシートに記入す...
お礼  にしもり  - 08/3/2(日) 14:03 -

引用なし
パスワード
   ▼かみちゃん さん:
>次から次へと質問されるのは、いいのですが、追加質問があるならば、「削除」キーを
>設定されているようですから、質問内容を削除し、投稿しなおしてはいかがですか?
申し訳ありません。そのようにします。ここまでありがとうございました。

【54248】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 14:07 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>次から次へと質問されるのは、いいのですが、追加質問があるならば、「削除」キーを
>>設定されているようですから、質問内容を削除し、投稿しなおしてはいかがですか?
>申し訳ありません。そのようにします。

それはどうでもよくて、こちらの質問に応えていただかないと前に進みませんよ。
結局何がしたいのでしょうか?

シートイベントでしていることを、標準モジュールでしようとすると、単純には
いかないですよ。
そのあたり何がしたいのか、きちんと説明できませんか?

【54249】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 14:08 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>以下のようにかえたら保存(コンパイル)はできたものの、Cnmなどが転記されず、また、ユーザーフォームがで表出されなくなってしまいました。

コンパイルは、とおるかもしれませんが、どのように実行しようとしているのか
教えてください。
単純に書き換えるだけではできません。

【54260】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 16:13 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>以上ですが(2)がまったくできていません。
>このような場合にユーザーフォームを使うのでしょうか。

Time(From)、Time(To)をComboBox(プルダウン)で選択させたいならば、
UserFormが簡単かと思います。
それで今までのスレッドを、総合すると、以下のような感じにしてはいかがでしょうか?

BeforeDoubleClickイベントのコードにしていますが、それと同等のコードが
Sampleマクロです。
Sampleマクロは、セルの書き込み部分など、できるだけ簡略にしています。
その他の部分は、できるだけ、にしもりさんが今できているものに近い形にして
あります。

'◆シートモジュール
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim Cnm As String
 Dim Pnm As String
 Dim Mnm As String
 Dim Tnm As String
' Dim ws1 As Worksheet
' Dim i As Long
 
 If Not Application.Intersect(Range("B3:B100"), Target) Is Nothing Then
  With Target
   Cnm = .Offset(, -1).Value
   Pnm = .Offset(0, 0).Value
   Mnm = .Offset(, 3).Value
   Tnm = .Offset(, 5).Value
  End With
  Set ws1 = Worksheets("history")
'  For i = 5 To ws1.Range("B65535").End(xlDown).Row
'   If IsEmpty(ws1.Cells(i, 2).Value) Then
'    ws1.Cells(i, 2).Value = Cnm
'    ws1.Cells(i, 3).Value = Pnm
'    ws1.Cells(i, 4).Value = Mnm
'    ws1.Cells(i, 9).Value = Tnm
'    Exit For
'   End If
'  Next i
  i = ws1.Range("B65536").End(xlUp).Row + 1
  If i < 5 Then
   i = 5
  End If
  ws1.Cells(i, 2).Value = Cnm
  ws1.Cells(i, 3).Value = Pnm
  ws1.Cells(i, 4).Value = Mnm
  ws1.Cells(i, 9).Value = Tnm
  Cancel = True
  UserForm1.Show
 End If
End Sub

'◆UserFormモジュール
Option Explicit

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double
 
 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
 Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
 Dim i As Integer
 Me.TextBox1.Value = Date
 With Me.ComboBox1
  For i = 1 To 24
   .AddItem i
  Next
 End With
 With Me.ComboBox2
  For i = 0 To 45 Step 15
   .AddItem i
  Next
 End With
 With Me.ComboBox3
  For i = 1 To 24
   .AddItem i
  Next
 End With
 With Me.ComboBox4
  For i = 0 To 45 Step 15
   .AddItem i
  Next
 End With
End Sub

'◆標準モジュール
Option Explicit

Public i As Long
Public ws1 As Worksheet

Sub Sample()
 If Not Application.Intersect(Range("B3:B100"), ActiveCell) Is Nothing Then
  With ActiveCell
   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
   ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
  End With
  Set ws1 = Worksheets("history")
  i = ws1.Range("B65536").End(xlUp).Row + 1
  If i < 5 Then
   i = 5
  End If
  UserForm1.Show
 Else
  MsgBox "B3〜B100セルのいずれかをアクティブにしてください。"
 End If
End Sub

>そしてsaveするとき、作業当日の日付けをシートhistoryのセルk3に書き込みたい。

とりあえず、これには、対応していません。
別対応でできます。

【54262】Re:フォームを用いて値をシートに記入す...
質問  にしもり  - 08/3/2(日) 16:26 -

引用なし
パスワード
   ▼かみちゃん さん:

まことに、まことにありがとうございます。
折角ですので御教示の標準モジュールですすめてみます。
その際ですが、やってみましたら

>'◆標準モジュール
>Option Explicit
>
>Public i As Long
>Public ws1 As Worksheet
>
>Sub Sample()
> If Not Application.Intersect(Range("B3:B100"), ActiveCell) Is Nothing Then
>  With ActiveCell
>   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
↑↑↑
オブジェクト変数またはwithブロック変数が定義されてない、と出てここで止まってしまいます。
どうすればよいかアドバイス願えませんでしょうか。

【54264】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん E-MAIL  - 08/3/2(日) 16:31 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>  With ActiveCell
>>   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
>↑↑↑
>オブジェクト変数またはwithブロック変数が定義されてない、と出てここで止まってしまいます。

申し訳ありません。
変数ws1 と i の代入の順番を間違えていました。動作確認不足です。

以下のように修正してください。

'◆標準モジュール
Option Explicit

Public i As Long
Public ws1 As Worksheet

Sub Sample()
 If Not Application.Intersect(Range("B3:B100"), ActiveCell) Is Nothing Then
  Set ws1 = Worksheets("history")
  i = ws1.Range("B65536").End(xlUp).Row + 1
  If i < 5 Then
   i = 5
  End If
  
  With ActiveCell
   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
   ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
  End With
  UserForm1.Show
 Else
  MsgBox "B3〜B100セルのいずれかをアクティブにしてください。"
 End If
End Sub

サンプルファイルで動作確認をいたしました。

【54266】Re:フォームを用いて値をシートに記入す...
お礼  にしもり  - 08/3/2(日) 16:44 -

引用なし
パスワード
   ▼かみちゃん さん:
まことにありがとうございます。
こちらも動作しました。
かくもご丁寧にご指導いただいき、ここから先は自力でやらねばならぬと存じます。
投稿のたび、毎回のようにかみちゃん様はじめ皆様に余りあるご指導をいただく結果となってしまうことをありがたいと同時に心苦しく思っております。
精進に努めたいと存じます。
本当にありがとうございました。

【54268】Re:フォームを用いて値をシートに記入す...
発言  かみちゃん  - 08/3/2(日) 16:55 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> ここから先は自力でやらねばならぬと存じます。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=54267;id=excel
にも書きましたが、自己解決したなら、どのように解決したのかは書くようにしましょう。
こちらのスレッドで提示したコードは、
> こちらも動作しました。
動作確認いただけたようですが、

あちらは、
>ありがとうございました
とだけあって、動いたのか動いていないのかがよくわかりません。

理解されるのは、少し時間がかかりそうですが、ゆっくりでいいので、
ひとつずつ理解されていけばいいと思います。

お世辞ではありませんが、よく質問されている、にしもりさんくらいのレベルで
あれば、必ず理解できると思います。

がんばってください。

【54276】Re:フォームを用いて値をシートに記入す...
お礼  にしもり  - 08/3/2(日) 18:09 -

引用なし
パスワード
   ▼かみちゃん さん:

'Date
ws1.Cells(i, 5).Value = Me.TextBox1.Value
の箇所を変えるといいましたが

Calendar1.Value = Date

および

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
End Sub

を追加するというのが正確でした。
躍るように動作しております。
ありがとうございました。


(標準モジュール)
Option Explicit

Public i As Long
Public ws1 As Worksheet

Sub Sample()
 If Not Application.Intersect(Range("B3:B104"), ActiveCell) Is Nothing Then
  Set ws1 = Worksheets("history")
  i = ws1.Range("B65536").End(xlUp).Row + 1
  If i < 5 Then
   i = 5
  End If
 
  With ActiveCell
   ws1.Cells(i, 2).Resize(, 3).Value = Array(.Offset(, -1).Value, .Value, .Offset(, 3).Value)
   ws1.Cells(i, 2).Offset(, 7).Value = .Offset(, 5).Value
  End With
  UserForm1.Show
 Else
  MsgBox "Programのいずれかをアクティブにしてください。"
 End If
End Sub


(ユーザーフォーム)
Option Explicit

Private Sub UserForm_Initialize()
  Calendar1.Value = Date
'  カレンダーの日付をセルにセットする
   Dim i As Integer
    Me.TextBox1.Value = Date
    With Me.ComboBox1
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox2
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
    With Me.ComboBox3
     For i = 1 To 24
      .AddItem i
     Next
    End With
    With Me.ComboBox4
     For i = 0 To 45 Step 15
      .AddItem i
     Next
    End With
End Sub

Private Sub Calendar1_Click()
  TextBox1.Value = Calendar1.Value
'  カレンダーの日付をセルにセットする
End Sub

Private Sub CommandButton1_Click()
 Dim From_Str As String
 Dim To_Str As String
 Dim Hours As Double

 If Me.ComboBox1.Value <> "" And Me.ComboBox2.Value <> "" Then
  From_Str = Me.ComboBox1.Value & ":" & Me.ComboBox2.Value
 End If
 If Me.ComboBox3.Value <> "" And Me.ComboBox4.Value <> "" Then
  To_Str = Me.ComboBox3.Value & ":" & Me.ComboBox4.Value
 End If
 If From_Str <> "" And To_Str <> "" Then
  Hours = (CDate(To_Str) - CDate(From_Str)) * 24
  'Date
  ws1.Cells(i, 5).Value = Me.TextBox1.Value
  'Time(From)
  ws1.Cells(i, 6).Value = CDate(From_Str)
  'Time(To)
  ws1.Cells(i, 7).Value = CDate(To_Str)
  'Hours
  ws1.Cells(i, 8).Value = (CDate(To_Str) - CDate(From_Str)) * 24
  'Place
  ws1.Cells(i, 10).Value = Me.TextBox2.Value
  'Notese
  ws1.Cells(i, 11).Value = Me.TextBox3.Value
 End If
  Unload UserForm1
End Sub

Private Sub UserForm_Deactivate()
  Unload UserForm1
End Sub

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