Workbooks.Add
Workbooks.Open Filename:="呼び出し先.xlsm"
Workbooks("呼び出し先.xlsm").Close
ActiveWorkbook.SaveAs Filename:="d:\asai\abc.xlsx"
ActiveWorkbook.Close
MsgBox ActiveWorkbook.path
MsgBox Workbooks("ファイル名.xlsx").path
MsgBox Workbooks("ファイル名.xlsx").Worksheets("シート名").Cells(行,列)
Sub ファイル存在()
Dim fullpath As String
fullpath = "d:\asai\練習\Sample1.xlsx"
If Dir(fullpath) <> "" Then
Workbooks.Open Filename:=fullpath
Else
MsgBox "そのブックは存在しません"
End If
End Sub
Dim flag As Boolean
Dim wb As Workbook
Dim MyFile As String
MyFile = "D:\教材\VBA\VBA実践塾\シート\呼び出し先.xlsm"
flag = False
For Each wb In Workbooks
If wb.FullName = MyFile Then
flag = True
MsgBox MyFile & "は既に開いています"
Exit For
End If
Next wb
If flag = False Then
MsgBox MyFile & "を開きます"
Workbooks.Open MyFile
End If
Sub auto_open()
Call kyou3mae
Call dataari
Call toridasi
End Sub
Sub torikomi()
Dim FileNamePath As Variant
Dim textline, csvline() As String
Dim Rowcnt, ColumNum As Integer
Dim ch1 As Long
Worksheets("名簿").Cells.Clear
ch1 = FreeFile
FileNamePath = "d:\移行データ\meibo.csv"
Open FileNamePath For Input As #ch1
Rowcnt = 1
Do While Not EOF(ch1)
Line Input #ch1, textline
csvline() = Split(textline, ",")
Range(Worksheets("名簿").Cells(Rowcnt, 1), _
Worksheets("名簿").Cells(Rowcnt, UBound(csvline()) + 1)) = csvline()
Rowcnt = Rowcnt + 1
Loop
End Sub
Sub CSV_Read2()
Dim FileType, Prompt As String
Dim FileNamePath As Variant
Dim textline, csvline() As String
Dim Rowcnt, ColumNum As Integer
Dim ch1 As Long
FileType = "CSV ファイル (*.csv),*.csv"
Prompt = "CSV File を選択してください"
'操作したいファイルのパスを取得します
FileNamePath = SelectFileNamePath(FileType, Prompt)
If FileNamePath = False Then 'キャンセルボタンが押された
End
End If
'空いているファイル番号を取得します
ch1 = FreeFile
'FileNamePath のファイルをオープンします
Open FileNamePath For Input As #ch1
'エラーが発生したらファイルを閉じます
'CSVのファイルは1行の項目数が正確に合っていないと読めないのですが、
'色々なCSVがあるようなので入れておきます
On Error GoTo CloseFile
'表の行番号の初期化 1行目から読み込んだデータを入力します
Rowcnt = 1
Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。
'1行読み込みます
Line Input #ch1, textline
'ダブルクォーテーションを削除します
'カンマ+ダブルクォーテーションで区切られている CSVファイル
'などは適時追加してください
textline = Replace(textline, """", "")
'カンマで分離します
csvline() = Split(textline, ",")
'配列渡しでセルに代入
Range(Cells(Rowcnt, 1), _
Cells(Rowcnt, UBound(csvline()) + 1)) = csvline()
Rowcnt = Rowcnt + 1
Loop
Cells(2, 4) = Round(Cells(1, 4))
CloseFile:
'ファイルを閉じます
Close #ch1
End Sub
Function SelectFileNamePath(FileType, Prompt) As Variant
SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function
Sub csvoutput()
Worksheets("合体").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\自分のデータ\ikou.csv", FileFormat:=xlCSV, _
CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Sub csvoutput1()
Dim FileNamePath As Variant
Dim ch1 As Long
Dim lastrow As Long
Dim i As Long
Dim j As Long
Dim data(4) As String
FileNamePath = "d:\自分のデータ\ikou.csv"
Worksheets("合体").Select
lastrow = Worksheets("合体").Cells(Rows.Count, 1).End(xlUp).Row
ch1 = FreeFile
Open FileNamePath For Output As #ch1
For i = 2 To lastrow
For j = 1 To 5
data(j - 1) = Cells(i, j)
Next
Write #ch1, data(0), data(1), data(2), data(3), data(4)
Next
Close #ch1
End Sub
Sub yobidasi()
Dim OpenFileName As String
OpenFileName = Application.GetOpenFilename("Excelブック,*.xlsx")
If OpenFileName <> "False" Then
Workbooks.Open OpenFileName
End If
End Sub
Path = "D:\文字列置換\指定1\指定11\"
buf = Dir(Path & "*.xlsx")
Do While buf <> ""
Workbooks.Open Path & buf
Worksheets("変更").Cells(1, 2) = "税込"
ActiveWorkbook.Close
buf = Dir()
Loop
Application.Quit