VBA - COMBINE 多個檔案成為 一個

VBA code :


Sub Append_Text_Files()


Dim oFS As FileSystemObject
Dim oFS1 As FileSystemObject

Dim oTS As TextStream
Dim oTS1 As TextStream

Dim vTemp

Set oFS = New FileSystemObject
Set oFS1 = New FileSystemObject


For i1 = 1 To 3

Set oTS = oFS.OpenTextFile(ActiveWorkbook.Path & "\" & "Doc" & i1 & ".txt", ForReading)
vTemp = oTS.ReadAll

Set oTS1 = oFS.OpenTextFile(ActiveWorkbook.Path & "\" & "Output.txt", ForAppending, True)
oTS1.Write (vTemp)
oTS1.Close
oTS.Close

Next i1

End Sub

上面的程式碼 : 將 Doc1.txt 加 Doc2.txt 加 Doc3.txt , 合成 新檔 "Output.txt"

VBA - Write & Print Different in (.TXT) FILE

VBA CODE "

Sub WriteToATextFile()
'first set a string which contains the path to the file you want to create.
'this example creates one and stores it in the root directory

 MyFile = ActiveWorkbook.Path & "\" & "whateveryouwant.txt"
'set and open file for output
fnum = FreeFile()
Open MyFile For Output As fnum
'write project info and then a blank line. Note the comma is required
Write #fnum, "I wrote this"
Print #fnum, Sheets("Sheet1").Range("a1")
'use Print when you want the string without quotation marks
Print #fnum, "I printed this OK"
Close #fnum
End Sub

OUTPUT FILE ( whateveryouwant.txt )

"I wrote this"
tooltips[0]=["xman.jpg", "G1(270),G2(198)(2nd)(paid5.0)<br /> <B>G3</B>(b75),G4(530)", {background:"#FFFFFF", color:"black", border:"5px ridge darkblue"}]
I printed this OK

Different in with / without quotation marks

在儲存格內可指定格式 (用text 功能)

用 text 可以 指定數字格式

="The Sum " &TEXT(H7,"HK$#,##0.00_);(HK$#,##0.00)")

Result : "The Sum HK$500,000.00"

用vba讀取在同一資料夾內檔案及其資訊 , 寫在即時運算視窗內

Option Explicit
Sub Get_file_info()
    Dim myFso As Scripting.FileSystemObject
    Dim myFiles As Scripting.Files
    Dim myFile As Scripting.File
    Set myFso = New Scripting.FileSystemObject
    '指定檔案
    Set myFiles = myFso.GetFolder(ThisWorkbook.Path).Files
       
    For Each myFile In myFiles
       
    With myFile
    Debug.Print "製作日:" & .DateCreated
    Debug.Print "最後存取日:" & .DateLastAccessed
    Debug.Print "最後更新日:" & .DateLastModified
    Debug.Print "Root磁碟機名:" & .Drive
    Debug.Print "檔案名稱:" & .Name
    Debug.Print "上層資料夾名稱:" & .ParentFolder
    Debug.Print "路徑:" & .Path
    Debug.Print "DOS用短名稱:" & .ShortName
    Debug.Print "DOS用短路徑:" & .ShortPath
    Debug.Print "大小:" & (.Size / 1024) & "KB"
    Debug.Print "類型:" & .Type
    End With
   
    Next

Excel VBA 選欄 或 選行

Excel VBA 選欄 或 選行

BASIC : Columns() & Rows()  only accepts one value, an integer of the column/row number.


(1) 選1行 或 選1欄
基本
Columns("B:B").Select
Rows("2:2").Select
可用變數的方法
Range(Columns(2), Columns(2)).Select  '選B欄 (1欄)
Range(Rows(2), Rows(2)).Select '選第2行 (1行)

(2) 選連續多行 或 選連續多欄
基本
Columns("B:D").Select
Rows("2:4").Select
可用變數的方法
Range(Columns(2), Columns(4)).Select  '選B欄,C欄,D欄 (3欄)
Range(Rows(2), Rows(4)).Select '選第2行,第3行,第4行 (3行)

(3) 選多行 或 選多欄 (不連續)
基本
Range("B:B,D:D,G:G").Select
Range("1:1,4:4,10:10").Select
可用變數的方法
Union(Rows(2),Rows(4),Rows(7)).Select  '選B欄,D欄,G欄 (3欄)
Union(Columns(1), Columns(4), Columns(10)).Select '選第1行,第4行,第10行 (3行)

Using VBA to write VBA code (create multiple buttons)

Sub AddComm_button()

Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet

Set CurSheet = Worksheets("Sheet1")

For iX = 1 To 2
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 126 * iX
myButton.Top = 96
myButton.Width = 126.75
myButton.Height = 25.5

Set myButton = Nothing
Next iX

For iX = 1 To 2
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"

'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.Name).Activate

With ThisWorkbook.VBProject.VBComponents(CurSheet.Name).CodeModule
.AddFromString (sCode)
End With

sCode = vbNullString
Next iX

End Sub

SOURCE : http://www.mrexcel.com/archive/VBA/1086.html



MY TRY (It's Work)



Sub CreateButton()

' 可能 出現 "於執行程式碼時出現以下錯誤 - 執行錯誤1004 - 對於VB專案的程式化存取未信任
' 要在 "工具>巨集>安全性 -  信任的來源>信任存取visual basic(v)專案 選項要打V


Dim Obj As Object
Dim Code As String

Sheets("主頁").Select
For i = 1 To 2
    h = 32
'create button
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=222, Top:=69 + (i + 1) * h, Width:=158, Height:=26)
    Obj.Name = "File_Button" & i
 
'buttonn text
    ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i

'macro text
    Code = "Sub " & "File_Button" & i & "_Click()" & vbCrLf
    Code = Code & "Call Module1.Tester" & vbCrLf
    Code = Code & "End Sub"
'add macro at the end of the sheet module
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
Next i
End Sub

Sub Tester()
    MsgBox "You have click on the test button"
End Sub


Sub Remove_Codes_in_Module()

' remove all code in a Module

Sheets("主頁").Select
 With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With

End Sub

Sub AddComm_button()

' Using VBA to write VBA code (create multiple buttons)

Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet

x = Sheets("File總表").Range("d1").Value   ' Buttom no.


Set CurSheet = Worksheets("主頁")
Sheets("主頁").Select
For i = 1 To x
    h = 32

Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 222
myButton.Top = 69 + (i - 1) * h
myButton.Width = 158
myButton.Height = 26

myButton.Name = "File_Button" & i
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i

Set myButton = Nothing

Next i

For iX = 1 To x
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
' sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"

'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).Activate

With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With

sCode = vbNullString
Next iX

End Sub

在 vba module 中 delete 所有 code

Sub test()

' remove all code in a Module

Sheets("主頁").Select
 With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With

End Sub