- ベストアンサー
Excel-VBA 撮影日時の取得
nda23の回答
- nda23
- ベストアンサー率54% (777/1415)
(1)一番簡単な方法 FileDateTime(sFile)→最終更新日が返る。 (2)ちょっと複雑な方法 Dim ファイルシステム Dim ファイル情報 Set ファイルシステム = CreateObject("Scripting.FileSystemObject) Set ファイル情報 = ファイルシステム.GetFile(sFile) MsgBox "作成日は" & ファイル情報.DateCreated & "です" MsgBox "アクセス日は" & ファイル情報.DateDateLastAccessed & "です" MsgBox "最終更新日は" & ファイル情報.DateLastModified& "です" (3)マニアックな方法 Private Type FILETIME 数値(1) As Long End Type Private Type SYSTEMTIME 年 As Integer 月 As Integer 曜日 As Integer 日 As Integer 時 As Integer 分 As Integer 秒 As Integer ミリ秒 As Integer End Type Private Declare Function FileTimeToSystemTime Lib "KERNEL32" _ (ファイル時刻 As FILETIME, システム時刻 As SYSTEMTIME) As Long Private Declare Function FileTimeToLocalFileTime Lib "KERNEL32" _ (世界協定時刻 As FILETIME, 地域時刻 As FILETIME) As Long Private Declare Function GetFileTime Lib "KERNEL32" _ (ByVal ハンドル As Long, 作成日 As FILETIME, _ アクセス日 As FILETIME, 最終更新日 As FILETIME) As Long Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" _ (ByVal パス名 As String, ByVal アクセスモード As Long, _ ByVal 共有モード As Long, ByVal 継承属性 As Long, _ ByVal 作成方式 As Long, ByVal ファイル属性 As Long, _ ByVal テンプレート As Long) As Long Private Declare Function CloseHandle Lib "KERNEL32" _ (ByVal ハンドル As Long) As Long Sub 撮影日時表示() Const sFile = ～ Dim ハンドル As Long Dim I As Long Dim 内部日付(2) As FILETIME Dim 表示日付(2) As String ハンドル = CreateFile(ファイル名, 0, 1, 0, 3, 128, 0) If ハンドル <> -1 Then GetFileTime ハンドル, 内部日付(0), 内部日付(1), 内部日付(2) CloseHandle ハンドル For I = 0 To 2 Dim ファイル日付 As FILETIME Dim システム日付 As SYSTEMTIME FileTimeToLocalFileTime 内部日付(I), ファイル日付 FileTimeToSystemTime ファイル日付, システム日付 表示日付(I) = CStr(システム日付.年) _ & "/" & Format(システム日付.月, "00") _ & "/" & Format(システム日付.日, "00") _ & " " & Format(システム日付.時, "00") _ & ":" & Format(システム日付.分, "00") _ & ":" & Format(システム日付.秒, "00") _ & "." & Format(システム日付.ミリ秒, "000") Next End If MsgBox "作成日は" & 表示日付(0) & "です" MsgBox "アクセス日は" & 表示日付(1) & "です" MsgBox "最終更新日は" & 表示日付(2) & "です" End Sub
関連するQ&A
- ●Ｅｘｃｅｌ ＶＢＡ 配列●教えて下さい
a～tの文字が順々に文字を追っていくプログラムにしたいと思い 配列を使用したのですが…プログラムが稼動しません、 下記のプログラムでは何が足りないのでしょうか わかる方いたら教えて下さい; 配列の使い方についてアドバイスがあれば そちらも教えていただきたいです…。 '――ここから―― Dim time1 As Integer, time2 As Integer, n As String Dim X As Integer, Y As Integer Dim yoko As String, tate As String Dim suuji (19) As String Sub 描画() Cells(X, Y).Value = suuji End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() suuji (0) = a suuji (1) = b suuji (2) = c suuji (3) = d suuji (4) = e suuji (5) = f suuji (6) = g suuji (7) = h suuji (8) = i suuji (9) = j suuji (10) = k suuji (11) = l suuji (12) = m suuji (13) = n suuji (14) = o suuji (15) = p suuji (16) = q suuji (17) = r suuji (18) = s suuji (19) = t For n = 0 To 19 Cells(X,Y).Value = suuji (n) Next X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub '――ここまでです―― 何度も同じような質問をさせてもらってすみません;
- ベストアンサー
- その他（プログラミング・開発）
- VBA教えて下さい
VBAのコード考えましたが上手くできません まず、例として ファイル名を 試験1 試験2の2つのエクセルのファイルがあります やりたい事 セルを1つ1つ調べる 試験1のファイル(今開いてるシート) のD1～D20セルのどれかのセルが何か入力されているならば 試験2のファイル(今開いてるシート) のB1～B20セルのどれかのセルをクリアする(例えばD5セルに値が入ってればB5セルをクリアすると言う内容です) をしたいです 考えたコードを書きます sub test() dim a as variant dim i as variant set a = workbooks("試験2").activesheet with workbooks("試験1").activesheet for i = 1 to 20 if cells(i,"D") <> "" then cells(i,a).clear end if next i end with end sub これでは上手く結果がでませんでした 勉強不足ですみませんm(__)m 宜しければコードを書いてくれると助かります 回答お願いします
- ベストアンサー
- Visual Basic
- vbaで正規表現
正規表現のコードなんですが、 上手く動きません。 何故でしょうか… Sub Test() Dim reg As Object Dim ans As Object Dim c As Range Set reg = CreateObject("VBScript.RegExp") For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)) With reg .Pattern = "^【[(1)-(20)](\d*/\d*)" Set ans = .Execute(c.Value) End With If ans > 0 Then If Len(ans(0).submatches(0)) > 0 Then Debug.Print c.Address & "|" & ans(0).submatches(0) End If End If Next End Sub
- 締切済み
- Visual Basic
- 【Excel VBA】日付の代入
現在以下の操作を行いたく、コードを作成しています。 ・20～23行で各最大値を抽出し、C列に代入する ・最大値に紐づく日付をD列に代入する ・D列の日付が入ったセルを改行し、 2行目に"(曜日)"を入力する <現在のExcelデータ詳細> A20："処理1" A21："処理2" A22："処理3" A23："処理4" B19～AF19：日付 B20～AF23：任意の数字 C31：処理1の最大値 C33：処理2の最大値 C35：処理3の最大値 C37：処理4の最大値 D31、D33、D35、D37：日付 L(曜日)を入力予定 最大値に紐づく日付をD列に代入するところで 躓いています。 ご教示いただけないでしょうか。 現在のコードは下記の通りです。 Sub 最大値の取得() Dim max As Long Dim row As Integer Dim column As Integer For row = 20 To 23 max = 0 For column = 2 To 32 If Cells(row, column).Value > max Then max = Cells(row, column).Value End If Next Cells((row - 20) * 2 + 31, 3).Value = max For i = 4 To 1 Step -4 '編集中 Cells((row - 20) * 2 + 31, 4).Value = Cells(row - i, column - 1) '編集中 Next End Sub
- ベストアンサー
- Excel（エクセル）
- VBA クラスモジュールの使い方わかりません。
為替データで検証中なのですがネットで使いたいクラスモジュールがあり、値の渡し方などわからなくて困ってます。 過去1ヶ月のデータで日付、始値、高値、安値、終値並んでいる値を標準モジュールからTRと言う名のクラスモジュールに渡して計算したいのですがわかりません。 標準モジュールのみで簡単なマクロを作れるレベルです。 下がTRクラスモジュールです。 どなたかお助けください。 Option Explicit Public Version As Long Public Description As String Public NumInSequences As Long Public NumParams As Long Private Sub Class_Initialize() Version = &H10000 Description = "TR(真のレンジ)" NumParams = 0 NumInSequences = 4 End Sub Public Sub Calc(A() As Double, O() As Double, H() As Double, L() As Double, C() As Double) Dim I As Integer Dim LastClose As Double '前日の終値 For I = LBound(A) To UBound(A) If C(I) = Invalid Then A(I) = Invalid GoTo NextElem End If Dim D1 As Double '今日の高値と安値の差 Dim D2 As Double '前日の終値から今日の高値までの差 Dim D3 As Double '前日の終値から今日の安値までの差 If LastClose = Invalid Then A(I) = Invalid LastClose = C(I) GoTo NextElem End If ' 3つのパターンのレンジを計算 D1 = H(I) - L(I) D2 = H(I) - LastClose D3 = LastClose - L(I) If D1 > D2 Then A(I) = D1 Else A(I) = D2 End If If (A(I) < D3) Then A(I) = D3 End If LastClose = C(I) NextElem: Next End Sub
- ベストアンサー
- オフィス系ソフト
- 全くの初心者ですVBA
どこが悪いかわかりません。 教えてください。 Sub テスト() Dim kekka As String Dim i As Integer tokuten = Worksheets("Sheet1").Cells(i, 1).Value For i = 1 To Worksheets("Sheet1").Range("A1").End(xlDown).Row.Count If tokuten >= 80 Then kekka = "合格" Else kekka = "不合格" kekka = Cells(i, 2) End If Next i End Sub シート１の A列に数値で得点が入っています。
- ベストアンサー
- その他（プログラミング・開発）
- ■Excel VBA グローバルな書き方■
Sub 跳ね返る() Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim hyouji As String, yoko As String, tate As String hyouji = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do Cells(X, Y).Value = hyouji '★ For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next Cells(X, Y).Value = hyouji For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next '★ If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If Loop End Sub ************************************ 上記のプログラムを Dim a() EndSub Dim b() EndSub Dim c() endSub Sub main（） a b c EndSub のような、mainを動かせばabcも動く グローバルな(ローカルでもいいのですが) プログラムにするにはどうしたらいいですか？ ★印から★印までの間の動作が同じような動作で 二つあるので、それを一つにまとめ 尚且つ、表示と時間稼ぎと表示削除の ３つの動作を分けた形にしたいです。 質問が下手で申し訳ありません…;;
- 締切済み
- その他（プログラミング・開発）
- エクセルVBAで xlOn xlOff の切替
エクセル2000です。 ワークシート上に配置したオブジェクトのVisibleのTrue Falseについては、test01の方法で切り替えることが出来ます。 では、Test02でIfで判定している、xlOn xlOff の切替についても同様にNOTを使って簡単に記述することはできないでしょうか？xlOn xlOff はTrue False ではないから無理なのでしょうか？ Sub test01() Dim o As Object For Each o In ActiveSheet.Buttons o.Visible = Not o.Visible Next o End Sub Sub test02() Dim o As Object For Each o In ActiveSheet.CheckBoxes If o.Value = xlOn Then o.Value = xlOff Else o.Value = xlOn End If Next o End Sub
- ベストアンサー
- オフィス系ソフト
- Excel-VBA フォルダの日時を取得・設定
目的は、Excel-VBAでフォルダのタイムスタンプを「取得・設定」したいのですが、 非力にてクマロの書き方が分かりません。 何方かご教授よろしくお願いいたします。 下記はサンプルコードを探していて、これだと目に留まったのですが、 Excel-VBAマクロで実行するコードに書き直す事ができませんでした。 '--------------------------------------------- 'VB.NET フォルダのタイムスタンプ取得・設定(6個)-(SNo.032) 'http://hanatyan.sakura.ne.jp/dotnet/index.html '--------------------------------------------- 'Sample1.フォルダの作成日時を取得する Private Sub Button1_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles Button1.Click Dim dt As DateTime dt = System.IO.Directory.GetCreationTime("c:test\") Debug.WriteLine(dt) End Sub '--------------------------------------------- 'Sample4.フォルダの作成日時を設定する Private Sub Button4_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles Button4.Click 'Directory.SetCreationTime メソッド System.IO.Directory.SetCreationTime("c:test\", DateTime.Now) End Sub '--------------------------------------------- 以上
- ベストアンサー
- Visual Basic
- ▲ExcelのVBA▼困っています
何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…？; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub
- ベストアンサー
- その他（プログラミング・開発）