EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub CopyDt_Click()
Workbooks.Open Filename:= _
"E:\My Project.xls\PS.BookShare\PO\PoBookShare.xlsx"
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
Cells.Select
Range("A:AD").Activate
Selection.Copy
Windows("AR.Form.xlsm").Activate
Sheets("Database").Range("A1").Select
ActiveSheet.Paste
End Sub
suka wrote:Sub CopyDt_Click()
Workbooks.Open Filename:= _
"E:\My Project.xls\PS.BookShare\PO\PoBookShare.xlsx"
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
Cells.Select
Range("A:AD").Activate
Selection.Copy
Windows("AR.Form.xlsm").Activate
Sheets("Database").Range("A1").Select
ActiveSheet.Paste
End Sub
Code: Select all
Sub CopyDt_Click()
Dim wbOpen As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name = "PoBookShare.xlsx" Then
wbOpen = True
End If
Next wb
If Not wbOpen Then
Workbooks.Open Filename:= _
"E:\My Project.xls\PS.BookShare\PO\PoBookShare.xlsx"
End If
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
Cells.Select
Range("A:AD").Activate
Selection.Copy
Windows("AR.Form.xlsm").Activate
Sheets("Database").Range("A1").Select
ActiveSheet.Paste
End Sub
อาจารย์คะ ขอรบกวนเพิ่ม Code ด้านบนนี้ ให้ไฟล์ PoBookShare เมื่อเปิดพร้อมกับ Minimizesnasui wrote: ลองปรับ Code เป็นตามด้านล่างครับCode: Select all
Sub CopyDt_Click() Dim wbOpen As Boolean Dim wb As Workbook For Each wb In Workbooks If wb.Name = "PoBookShare.xlsx" Then wbOpen = True End If Next wb If Not wbOpen Then Workbooks.Open Filename:= _ "E:\My Project.xls\PS.BookShare\PO\PoBookShare.xlsx" End If ActiveWorkbook.Save Windows("PoBookShare.xlsx").Activate Cells.Select Range("A:AD").Activate Selection.Copy Windows("AR.Form.xlsm").Activate Sheets("Database").Range("A1").Select ActiveSheet.Paste End Sub
Code: Select all
Sub Macro6()
'
' Macro6 แมโคร
'
'
ActiveWindow.WindowState = xlMinimized
End Sub
Windows("PoBookShare.xlsx").Activate
ลองตามตัวอย่างด้านล่างนี้ Minimize ได้ค่ะ แต่เกรงจะมีผลกระทบกับไฟล์งานหรือไม่ค่ะ ขอบคุณค่ะsnasui wrote: เพิ่มบรรทัดนี้เข้าไปก่อนที่จะ Minimize ครับ
Windows("PoBookShare.xlsx").Activate
Code: Select all
Private Sub Workbook_Open()
Workbooks.Open Filename:= _
"\\Server\DATA (E)\My P S Project.xls\PS.BookShare\AR\ArBookShare.xlsx"
ActiveWindow.WindowState = xlMinimized
End Sub
เข้าใจแล้วค่ะนำไปใช้กับ Workbook ถึงได้ Error ค่ะ ขอบพระคุณค่ะอาจารย์snasui wrote:การที่ให้เพิ่ม Code นั้นก่อนก็เพื่อที่จะให้มั่นใจว่า Workbook ไหนที่ต้องการย่อก็ให้ Active ขึ้นมาก่อน จะได้ย่อไม่ผิด Workbook
Code: Select all
Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("PoBookShare.xlsx")
Application.ScreenUpdating = False
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
MsgBox "Please check your data. This transaction already recorded."
Exit Sub
End If
If Worksheets("Enterthedata").Range("B204") = "" Then
MsgBox "Your data is empty. Fill your data and click record button again."
Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
With Worksheets("Enterthedata")
If Len(.Range("M2")) = 6 Then
.Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
ElseIf Len(.Range("M2")) = 7 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
ElseIf Len(.Range("M2")) = 8 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 7) + 1
Else
.Range("M2") = .Range("M2") + 1
End If
End With
Application.ScreenUpdating = True
Windows("PO.Form.xlsm").Activate
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
ActiveWorkbook.Save
End Sub
Code: Select all
Set rt = Worksheets("Database").Range("A1048576").End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
MsgBox "Please check your data. This transaction already recorded."
Exit Sub
End If
Code: Select all
Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("PoBookShare.xlsx")
Application.ScreenUpdating = False
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
End If
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = Worksheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
MsgBox "Please check your data. This transaction already recorded."
Exit Sub
End If
If Worksheets("Enterthedata").Range("B204") = "" Then
MsgBox "Your data is empty. Fill your data and click record button again."
Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
With Worksheets("Enterthedata")
If Len(.Range("M2")) = 6 Then
.Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
ElseIf Len(.Range("M2")) = 7 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
ElseIf Len(.Range("M2")) = 8 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 7) + 1
Else
.Range("M2") = .Range("M2") + 1
End If
End With
Application.ScreenUpdating = True
Windows("PO.Form.xlsm").Activate
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
ActiveWorkbook.Save
End Sub
Code: Select all
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
End If
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = Worksheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Code: Select all
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Code: Select all
Set rt = Worksheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Code: Select all
Set rt = Worksheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Code: Select all
Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Dim rd As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("PoBookShare.xlsx")
Application.ScreenUpdating = False
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
End If
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rd = Worksheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
MsgBox "Please check your data. This transaction already recorded."
Exit Sub
End If
If Worksheets("Enterthedata").Range("B204") = "" Then
MsgBox "Your data is empty. Fill your data and click record button again."
Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
With Worksheets("Enterthedata")
If Len(.Range("M2")) = 6 Then
.Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
ElseIf Len(.Range("M2")) = 7 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
ElseIf Len(.Range("M2")) = 8 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 7) + 1
Else
.Range("M2") = .Range("M2") + 1
End If
End With
Application.ScreenUpdating = True
Windows("PO.Form.xlsm").Activate
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
ActiveWorkbook.Save
End Sub
Code: Select all
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
Code: Select all
With formBook
i = .Worksheets("Enterthedata").Range("C225")
End With
Code: Select all
Sub PasteData()
Dim wbShare As Workbook
Dim formBook As Workbook
Dim i As Integer
Dim rs As Range
Dim rt As Range
Dim rd As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("PoBookShare.xlsx")
Application.ScreenUpdating = False
With formBook
i = Worksheets("Enterthedata").Range("C225")
End With
With Worksheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
End If
With formBook
i = formBook.Sheets("Enterthedata").Range("C225")
End With
With formBook.Sheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rd = formBook.Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
MsgBox "Please check your data. This transaction already recorded."
Exit Sub
End If
If Worksheets("Enterthedata").Range("B204") = "" Then
MsgBox "Your data is empty. Fill your data and click record button again."
Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Enterthedata").Range("D2,B204:B220,D204:D220,L204:L220,D222, E204:F220").ClearContents
With Worksheets("Enterthedata")
If Len(.Range("M2")) = 6 Then
.Range("M2") = Left(.Range("M2"), 2) & Right(.Range("M2"), 4) + 1
ElseIf Len(.Range("M2")) = 7 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 6) + 1
ElseIf Len(.Range("M2")) = 8 Then
.Range("M2") = Left(.Range("M2"), 1) & Right(.Range("M2"), 7) + 1
Else
.Range("M2") = .Range("M2") + 1
End If
End With
Application.ScreenUpdating = True
Windows("PO.Form.xlsm").Activate
ActiveWorkbook.Save
Windows("PoBookShare.xlsx").Activate
ActiveWorkbook.Save
End Sub
Code: Select all
With formBook
i = formBook.Sheets("Enterthedata").Range("C225")
End With
With formBook.Sheets("Template")
Set rs = .Range(.Range("A2"), .Range("AC" & i + 1))
End With
Set rd = formBook.Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If Worksheets("Enterthedata").Range("C225") = True Then
Code: Select all
End If
Code: Select all
Dim rd As Range
Code: Select all
Set rd = formBook.Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)