Excel VBA質問箱 IV

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

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


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

【42312】変更箇所を記録するには にしもり 06/9/6(水) 13:49 質問[未読]
【42318】Re:変更箇所を記録するには mw 06/9/6(水) 15:46 回答[未読]
【42319】Re:変更箇所を記録するには にしもり 06/9/6(水) 16:04 質問[未読]
【42353】Re:変更箇所を記録するには ハチ 06/9/7(木) 17:47 回答[未読]
【42361】Re:変更箇所を記録するには Kein 06/9/8(金) 2:16 回答[未読]
【42370】Re:変更箇所を記録するには にしもり 06/9/8(金) 13:26 質問[未読]
【42385】Re:変更箇所を記録するには ponpon 06/9/9(土) 0:24 発言[未読]
【42443】Re:変更箇所を記録するには にしもり 06/9/12(火) 10:44 質問[未読]
【42445】Re:変更箇所を記録するには ハチ 06/9/12(火) 12:00 発言[未読]
【42452】Re:変更箇所を記録するには にしもり 06/9/12(火) 15:02 お礼[未読]

【42312】変更箇所を記録するには
質問  にしもり  - 06/9/6(水) 13:49 -

引用なし
パスワード
   次のようなVBAを書きました。
TextBox4に入れた文字が CommandButton1をクリックするとSheet2の2行目以下に書かれます。

Private Sub CommandButton1_Click()

Dim MyRange As Range
Dim addrow As Integer

  Set MyRange = Sheet2.Range("A1").CurrentRegion
  addrow = MyRange.Rows.Count + 1
  MyProc (addrow)
  
End Sub
Public Sub MyProc(MyRowCount As Integer) 'データ書き込み の 行数

Dim MyRange As Range           'データ範囲
Dim cnt As Integer

  cnt = 1
  Worksheets("Sheet2").Activate
  Set MyRange = Sheet2.Range("A1").CurrentRegion
  MyRange.Cells(MyRowCount, cnt).Value = TextBox4.Value
  cnt = cnt + 1
  TextBox4.Value = ""

End Sub
Private Sub CommandButton2_Click()

  TextBox4.Value = ""

End Sub
Private Sub CommandButton3_Click()

  ThisWorkbook.Worksheets("Sheet1").Select
  ActiveWorkbook.Save
  ActiveWorkbook.Close

End Sub
Private Sub TextBox4_Change()

End Sub
Private Sub UserForm_Click()

End Sub

で、御聞きしたいのはVBAそのものではなくて、変更履歴の記録についてです。
「ツール」「変更履歴の記録」「変更箇所の表示」を押すとボックスがでて、
編集中に変更箇所を記録する(ブックを共有する) にチェックを入れるようになっています。私は、ブック共有にしてまうと(たとえば)2名が同時にSHEET2のA2に入力しようとするとバッティングすると思ったので、ブックの共有にはしていません。変更履歴の記録は、ブックを共有にしないとできないのでしょうか?
どなたか詳しい方、御教えください。

【42318】Re:変更箇所を記録するには
回答  mw  - 06/9/6(水) 15:46 -

引用なし
パスワード
   こんにちは

logファイルに書き出すってのはどうでしょう?

見当違いなら無視して下さい

【42319】Re:変更箇所を記録するには
質問  にしもり  - 06/9/6(水) 16:04 -

引用なし
パスワード
   ▼mw さん:
ありがとうございます。

>logファイルに書き出すってのはどうでしょう?
Logファイルに書くとは、どうすればできるのでしょうか。
ごめんなさい、まったく知識がありません。
変更をしたひとの社員IDが判ればそれでいいのですが。。

【42353】Re:変更箇所を記録するには
回答  ハチ  - 06/9/7(木) 17:47 -

引用なし
パスワード
   ▼にしもり さん:
>Logファイルに書くとは、どうすればできるのでしょうか。
>ごめんなさい、まったく知識がありません。
>変更をしたひとの社員IDが判ればそれでいいのですが。。

意味を理解できないマクロを使うとメンテに困りますので
使用する前にマクロの内容を調べてからにしてください。
社員IDをどうやって取得するのかわかりませんので、
とりあえずログイン名で。
マクロを記入した後、一度Bookを閉じてください。
Sheetの情報を変更するとBook同じフォルダに"変更.Log"が出来ます。
エラー処理は入れてません。

'ThisWorkbookモジュールへ
Option Explicit

Private Sub Workbook_Open()
  Dim WSN As Object
  
  Set WSN = CreateObject("WScript.Network")
  myName = WSN.UserName
  Set WSN = Nothing
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim R As Range
  Dim buf As Variant
  
  For Each R In Target.Cells
    buf = Array(myName, Sh.Name, R.Address(0, 0), R.Value) 'Logingする情報
    Add_Log (buf)
  Next R
  Erase buf
End Sub

'標準モジュールへ
Option Explicit

Public myName As String

Sub Add_Log(Str As Variant)
  Dim myPath As String
  myPath = ThisWorkbook.Path '保存先
  Const myFile As String = "\変更.Log"  'ファイル名
  
  Open myPath & myFile For Append As #1
      Write #1, Join(Str, ",")
  Close #1

End Sub

【42361】Re:変更箇所を記録するには
回答  Kein  - 06/9/8(金) 2:16 -

引用なし
パスワード
   >2名が同時にSHEET2のA2に入力
通常、人が手でする操作を、PCが"同時"と解釈することはありません。
コンマ以下何桁までも一致しているかどうか・・という次元の問題に
なるからです。なので
>バッティングすると思った
のは杞憂ですが、そんなことを考えなかったとしても、ブックを共有する
のは止めておいた方が無難なようです。いろいろとバグが報告されてますので。
で、誰かが書いているように、ログファイルを残すのも一つの手でしょう。
その場合、マクロは CommandButton1_Click イベント一つにまとめて
しまうことが出来ます。コードは・・

Private Sub CommandButton1_Click()
  Dim MyF As String, Buf As String
 
  With TextBox4
   If .Text = "" Then Exit Sub
   Sheets("Sheet2").Range("A65536").End(xlUp) _
   .Offset(1).Value = .Text
   Buf = Format(Time, "hh:mm:ss") & " ; " & .Text
   .Text = ""
  End With
  MyF = Application.DefaultFilePath & _
  "\Log_" & Format(Date, "yymmdd") & ".txt"
  Open MyF For Append Access Write As #1
  Print #1, Buf
  Close #1
End Sub

ぐらいで、よいと思います。

【42370】Re:変更箇所を記録するには
質問  にしもり  - 06/9/8(金) 13:26 -

引用なし
パスワード
   ▼Kein さん,ハチさん:
ありがとうございます。
keinさんのを実行したらエラーにならなかったのですが、application default pathというのがどこのpathを指すのかわかりませんのでどこにできたのかわかりません。もう少しやってみます。

【42385】Re:変更箇所を記録するには
発言  ponpon  - 06/9/9(土) 0:24 -

引用なし
パスワード
   こんばんは。
>application default pathというのがどこのpathを指すのかわかりませんのでどこにできたのかわかりません。
applicationは、エクセルだから、
ツール→オプション→カレントフォルダ名に書かれているフォルダでは?

MsgBox Application.DefaultFilePath こうすれば一発です。

【42443】Re:変更箇所を記録するには
質問  にしもり  - 06/9/12(火) 10:44 -

引用なし
パスワード
   ▼Kein さん ponpon さん:
adviseいただいたロジックを追加してみました。
カレントドライブも確認しました。
が、txtファイルが出来ていません。
どこが悪いでしょうか。
すみません、基本ができていません。

Private Sub CommandButton1_Click()

Dim MyRange As Range
Dim addrow As Integer

  Set MyRange = Sheet2.Range("A1").CurrentRegion
  addrow = MyRange.Rows.Count + 1
  MyProc (addrow)

'ここからkein様のadvise
  Dim MyF As String, Buf As String
 
  With TextBox4
   If .Text = "" Then Exit Sub
   Sheets("Sheet2").Range("A65536").End(xlUp) _
   .Offset(1).Value = .Text
   Buf = Format(Time, "hh:mm:ss") & " ; " & .Text
   .Text = ""
  End With
  MyF = Application.DefaultFilePath & _
  "\Log_" & Format(Date, "yymmdd") & ".txt"
 
'ここponpon様のadvise
  MsgBox Application.DefaultFilePath
 
  Open MyF For Append Access Write As #1
  Print #1, Buf
  Close #1


End Sub
Public Sub MyProc(MyRowCount As Integer) 'データ書き込み の 行数

Dim MyRange As Range           'データ範囲
Dim cnt As Integer

  cnt = 1
  Worksheets("Sheet2").Activate
  Set MyRange = Sheet2.Range("A1").CurrentRegion
  MyRange.Cells(MyRowCount, cnt).Value = TextBox4.Value
  cnt = cnt + 1
  TextBox4.Value = ""

End Sub
Private Sub CommandButton2_Click()

  TextBox4.Value = ""

End Sub
Private Sub CommandButton3_Click()

  ThisWorkbook.Worksheets("Sheet1").Select
  ActiveWorkbook.Save
  ActiveWorkbook.Close

End Sub
Private Sub TextBox4_Change()

End Sub
Private Sub UserForm_Click()

End Sub


追記:ハチ様のadviseですが、マクロの意味を理解できていません。kein様のをやってみたのちに解釈してみます。すこしお時間ください。

【42445】Re:変更箇所を記録するには
発言  ハチ  - 06/9/12(火) 12:00 -

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

>追記:ハチ様のadviseですが、マクロの意味を理解できていません。kein様のをやってみたのちに解釈してみます。すこしお時間ください。

本文をよく読まずに、
WorkSheeetの変更をロギングするように作ってしまったので
無駄に動くと思います。

他の方の書き込みを参考に進めてください^^;

【42452】Re:変更箇所を記録するには
お礼  にしもり  - 06/9/12(火) 15:02 -

引用なし
パスワード
   ▼ハチ さん:

>他の方の書き込みを参考に進めてください^^;
承知しました。ありがとうございます。

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