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

VBA 加 BUTTOM 並加 CODE

Adding a VBA CommandButton with its respective the code

Paste these two sections of code into a general module (Module1 for example). 

Sub CreateButton()           

Dim Obj As Object           
Dim Code As String           

Sheets("Sheet1").Select           

'create button           
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _           
    Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)           
    Obj.Name = "TestButton"           
'buttonn text           
    ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"           

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

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

於執行程式碼時出現以下錯誤
執行錯誤1004 
對於VB專案的程式化存取未信任

ANSWER
工具>巨集>安全性
信任的來源>信任存取visual basic(v)專案
選項要打V

MY WORK :

Sub Set_Buttons_Codes()

' 建立按鍵後的程式


x = Sheets("File總表").Range("d1").Value   ' Button 需要的數量

For iX = 1 To x

a = Cells(4 + iX, 4).Value ' File Exist or not
b = Cells(4 + iX, 5).Value ' File Open or not
c = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 4, False) ' FILE名
d = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 3, False) ' file路徑

If a = "Y" Then

'Code for button(沒有此檔案)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 沒有此檔案 " & vbCrLf
sCode = sCode & "' NOTHING TO DO  " & vbCrLf
sCode = sCode & "End Sub"

ElseIf b = "Y" Then

'Code for button(檔案已開啟)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 檔案已開啟 " & vbCrLf
sCode = sCode & "Windows(" & Chr(34) & c & Chr(34) & ").Activate" & vbCrLf
sCode = sCode & "End Sub"
 
Else

'Code for button(檔案存在 , 但未開啟)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 檔案存在 , 但未開啟 " & vbCrLf
sCode = sCode & "Workbooks.Open Filename:= _" & vbCrLf
sCode = sCode & Chr(34) & d & "\" & c & Chr(34) & vbCrLf
sCode = sCode & "End Sub"


End If

'Write code for button(IN SHEET2)
ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).Activate

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

'add macro at the end of the sheet module
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .InsertLines .CountOfLines + 1, sCode
    End With

sCode = vbNullString

Next iX

End Sub