エクセルを開いたらカウントしたい 何回ひらいたかどの位使用しているのか知りたい セルa1に表示回数

エクセルを開いたらカウントしたい
何回ひらいたかどの位使用しているのか知りたい
セルa1に表示回数

質問者からの補足コメント

• 

  有難うございます。
  しかし、問題がありました。
  保存しないで閉じるとカウントが
  されません。なにか、いい方法はないでしょぅか

  No.1の回答に寄せられた補足コメントです。 補足日時：2018/03/17 07:47

• Workbooks. Sheet name. Saveでやりましたがダメでした

    補足日時：2018/03/17 09:06

No.3 ベストアンサー 回答者： tom04 回答日時： 2018/03/17 09:24

No.1です。

すでにNo.2さんが的確な回答をされていますので、余計なお世話かもしれませんが・・・
強制的に上書き保存させるだけです。

Private Sub Workbook_Open()
With Worksheets("Sheet1").Range("A1")
.Value = .Value + 1
End With
ThisWorkbook.Save
End Sub

こんな感じで　m(_ _)m

No.4 回答者： WindFaller 回答日時： 2018/03/17 14:44

こんにちは。

私も少し考えてみました。
ただし、
>　セルa1に表示回数
これでは、Saved プロパティが変わってしまいますので、ステータスバーを使うことにしました。
最初の一回目だけは、1が立つけれども、それは表示には出ません。2度目からです。
ファイル・ベース名.ini ファイルに書き込まれます。もし、これが消されることが心配なら、別の場所の方がよいかもしれません。

'//ThisWorkbook モジュール
Private Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias _
　"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal _
　lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As _
　Long
Private Declare Function GetPrivateProfileInt Lib "kernel32.dll" Alias _
　"GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName _
　As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Sub FirstIniWrite()
　Dim sFN As String
　Dim msg As Long
　Dim Ret As Long
　Dim fn As String
　Const sName As String = "Count"
　Const myKey As String = "Times"
　Const vbMyError As Integer = 513
　On Error GoTo ErrHandler
　fn = ThisWorkbook.Name
　fn = Left(fn, InStrRev(fn, ".") - 1)
　sFN = Application.DefaultFilePath & "\" & fn & ".ini"
　If Dir(sFN) <> "" Then
　　 msg = iniRead(sFN)
　　 msg = CLng(msg) + 1
　　 Ret = WritePrivateProfileString(sName, myKey, CStr(msg), sFN)
　　 Application.StatusBar = "times: " & CStr(msg)
　Else
　　 Ret = WritePrivateProfileString(sName, myKey, "1", sFN)
　End If
　If Ret = 0 Then
　　 MsgBox "iniファイルの作成に失敗ししまた。", vbCritical
　　 Err.Raise vbMyError
　End If
　Exit Sub
ErrHandler:
　MsgBox Err.Description
End Sub
Private Function iniRead(ByVal sFN As String) As Long
　Dim sName As String
　Dim myKey As String
　Dim deFault As Long
　Dim Ret As Long
　sName = "Count"
　myKey = "Times"
　deFault = 1
　Ret = GetPrivateProfileInt(sName, myKey, deFault, sFN)
　iniRead = Ret
End Function

Private Sub Workbook_Open()
Call FirstIniWrite
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.StatusBar = False　'シートに入力すれば、ステータスバーの回数は消えます。
End Sub

No.2 回答者： fujillin 回答日時： 2018/03/17 08:31

こんにちは。

＞保存しないで閉じるとカウントがされません
カウントしたら上書き保存するまでを併せて実行するようにしておくだけ。

No.1 回答者： tom04 回答日時： 2018/03/16 23:33

こんばんは！

＞セルa1に表示回数
Sheet1のA1セルとします。

Private Sub Workbook_Open()
With Worksheets("Sheet1").Range("A1")
.Value = .Value + 1
End With
End Sub

で大丈夫だと思います。m(_ _)m