000000 ランダム
 ホーム | 日記 | プロフィール 【フォローする】 【ログイン】

勉強ブログ

PR

X

全10件 (10件中 1-10件目)

1

カテゴリ未分類

2018.05.31
XML
カテゴリ:カテゴリ未分類
Option Explicit

' 指定したフォルダ内のファイルの一覧を取得
Sub Display_Directory()
Const cnsTitle = "フォルダ内のファイル名一覧取得"
Const cnsDIR = "\*.*"
Dim xlAPP As Application
Dim THIS_WORKBOOK_NAME As String

Dim strPathName As String, vntPathName As Variant
Dim vntSheet As Variant
Dim strFileName As String
Dim line As Long

THIS_WORKBOOK_NAME = ThisWorkbook.Name
'開始行番号
line = 2

Set xlAPP = Application
' InputBoxでフォルダ指定を受ける
vntPathName = xlAPP.InputBox("参照するフォルダ名を入力して下さい。", _
cnsTitle, CurDir)
If VarType(vntPathName) = vbBoolean Then Exit Sub
strPathName = vntPathName
' フォルダの存在確認
If Dir(strPathName, vbDirectory) = "" Then
MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTitle
Exit Sub
End If

' 先頭のファイル名の取得
strFileName = Dir(strPathName & cnsDIR, vbNormal)
' ファイルが見つからなくなるまで繰り返す
Do While strFileName <> ""

' Excelのみ対象
If (InStr(1, strFileName, ".xls", vbTextCompare)) <> 0 And strFileName <> THIS_WORKBOOK_NAME Then


Workbooks.Open Filename:= _
vntPathName & "\" & strFileName

For Each vntSheet In Sheets
'ファイル名を1列目にセット
Workbooks(1).Sheets(1).Cells(line, 1).Value = strFileName
Workbooks(1).Sheets(1).Cells(line, 2).Value = vntSheet.Name
' 行を加算
line = line + 1
Next vntSheet

ActiveWindow.Close

End If

' 次のファイル名を取得
strFileName = Dir()
Loop

Call MsgBox("ファイル・シート名出力が完了しました", vbOKOnly, "終了メッセージ")
End Sub






最終更新日  2018.05.31 14:46:55
コメント(0) | コメントを書く


2018.02.02
カテゴリ:カテゴリ未分類
'------------------------------------------------------------------
'概要=
'引数=
'戻値
'引数の型=
'戻値の型=
'その他=
'------------------------------------------------------------------






最終更新日  2018.02.02 19:31:18
コメント(0) | コメントを書く
2017.12.24
カテゴリ:カテゴリ未分類
レジストリに値を設定するコマンド
=REG ADDーーーーーーーーーーーーーーーーーーー

パソコンFAQ






最終更新日  2017.12.24 16:26:57
コメント(0) | コメントを書く
2017.12.12
カテゴリ:カテゴリ未分類
Function read_variant(start_cell As Variant, end_cell As Variant, column As Long, row As Long, value As String) As Variant
'概要=指定した範囲(マトリクス)から、その値とx/yの値を読み込んで、配列に格納する
'引数=読み込    む範囲
'引数=x/yのキー行/列
'戻り値=配列(値/xのキー/yのキー)
End Function
Sub call_list_matrix()
Dim start_cell(0, 1)
'スタートセルのアドレスを代入
start_cell(0, 0) = 2
start_cell(0, 1) = 2
Dim end_cell(0, 1)
'エンドセルのアドレスを代入
end_cell(0, 0) = 3
end_cell(0, 1) = 4
Call list_matrix(start_cell, end_cell)
End Sub
Function list_matrix(start_cell As Variant, end_cell As Variant) As Variant
'マトリクスの要素一覧を返す関数
'要素一覧を格納する配列の行数を求めて変数に格納する
Dim row_number As Long
row_number = Abs(end_cell(0, 0) - start_cell(0, 0) + 1) * Abs(end_cell(0, 1) - start_cell(0, 1) + 1)
'配列を宣言
ReDim list_matrix_inner(row_number, 1)
End Function






最終更新日  2017.12.12 23:13:07
コメント(0) | コメントを書く
2017.12.04
カテゴリ:カテゴリ未分類






最終更新日  2017.12.04 09:17:50
コメント(0) | コメントを書く
2017.11.04
カテゴリ:カテゴリ未分類
ブック名
シート名
オブジェクト名
オブジェクトタイプ
オブジェクト名前
オブジェクトテキスト
オブジェクト左上セル番地
オブジェクト右下セル番地
オブジェクト幅
オブジェクト高さ








最終更新日  2017.11.04 16:35:07
コメント(0) | コメントを書く
2017.11.01
カテゴリ:カテゴリ未分類
1. [スタートメニュー] – [ファイル名を指定して実行] – [regedit]と入力し、レジストリエディタを起動する 
2. 左ペインから[マイコンピュータ]- [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths]を右クリックする 
3. [新規] – [キー]を選択する 
4. 作成された[新しいキー #1]を右クリック する 
5. [名前の変更]を選択する 
6. [sakura.exe]と入力し、名前を変更する(※ [.exe]の付け忘れに注意!) 
7. 右ペインの[(既定)]を右クリックする 
8. [修正]を選択する 
9. [値のデータ]欄にサクラエディタのパス(以下)を入力し、[OK]を選択する 
・C:\Program Files\sakura\sakura.exe 
10. [ファイル名を指定して実行] に[sakura]と入力し、サクラエディタが起動されることを確認する

ほぼニートの資格取得日記(マラソン編)






最終更新日  2017.11.01 01:32:38
コメント(0) | コメントを書く
2017.10.19
カテゴリ:カテゴリ未分類






最終更新日  2017.10.19 21:25:12
コメント(0) | コメントを書く
2017.08.31
カテゴリ:カテゴリ未分類
Sub Sample1()
    Dim rc As Long
    rc = Shell("notepad.exe", vbNormalFocus)
    If rc = 0 Then MsgBox "起動に失敗しました"
End Sub

moug






最終更新日  2017.08.31 01:02:37
コメント(0) | コメントを書く
2017.08.17
カテゴリ:カテゴリ未分類
Sub main()
'変数宣言
Dim activecell_row As Integer
Dim activecell_column As Integer
Dim loop_count As Integer
loop_count = 1
Dim i As Integer
Dim row_number As Integer
row_number = 5
Dim loop_cnt As Integer
loop_cnt = 0
Dim sheetname As String
sheetname = "new sheet"
'シート追加
Worksheets.Add.Name = sheetname
'必要な文言を追加
Worksheets("new sheet").Range("B1") = "行"
Worksheets("new sheet").Range("C1") = "列"
Worksheets("new sheet").Range("D1") = "フォルダ(行)"
Worksheets("new sheet").Range("E1") = "フォルダ(列)"
Worksheets("new sheet").Range("F1") = "フォルダ"
Worksheets("new sheet").Range("G1") = "グループ(行)"
Worksheets("new sheet").Range("H1") = "グループ(列)"
Worksheets("new sheet").Range("I1") = "グループ"
Worksheets("new sheet").Range("J1") = "付与内容(行)"
Worksheets("new sheet").Range("K1") = "付与内容(列)"
Worksheets("new sheet").Range("L1") = "付与内容"
'セルをアクティブ化(本来はBE9)
Worksheets("FAD").Activate
Range("C3").Activate
'繰り返し
Do Until ActiveCell.Value = "endend"
'空白の場合→右へ1つ移動
If ActiveCell.Value = "" Then
ActiveCell.Offset(0, 1).Select
'end→下へ一つ移動+左へ列数分移動
ElseIf ActiveCell.Value = "end" Then
ActiveCell.Offset(1, "-" & row_number).Select
Else
activecell_row = ActiveCell.row
activecell_column = ActiveCell.column
loop_count = loop_count + 1
Worksheets(sheetname).Range("B" & loop_count) = activecell_row
Worksheets(sheetname).Range("C" & loop_count) = activecell_column
ActiveCell.Offset(0, 1).Select
loop_cnt = loop_cnt + 1
End If
Loop
'新しいシートを編集
Dim copy As Integer
Dim copy2 As Integer
Dim copy3 As String
Dim copy4 As String
For i = 2 To loop_cnt + 1
Worksheets(sheetname).Activate
'コピーと定数
copy = Range("b" & i)
Range("d" & i).Value = copy
Range("j" & i).Value = copy
Range("e" & i).Value = 2
Range("g" & i).Value = 2
copy2 = Range("c" & i)
Range("h" & i).Value = copy2
Range("k" & i).Value = copy2
'他シートからコピー
copy3 = Worksheets("FAD").Cells(copy, 2)
Worksheets("new sheet").Range("f" & i) = copy3
copy3 = Worksheets("FAD").Cells(2, copy2)
Worksheets("new sheet").Range("i" & i) = copy3
copy3 = Worksheets("FAD").Cells(copy, copy2)
Worksheets("new sheet").Range("l" & i) = copy3
Next
MsgBox "完了"
End Sub








最終更新日  2017.08.17 13:53:57
コメント(0) | コメントを書く

全10件 (10件中 1-10件目)

1


© Rakuten Group, Inc.