- ©«¤l
- 127
- ¥DÃD
- 56
- ºëµØ
- 0
- ¿n¤À
- 176
- ÂI¦W
- 0
- §@·~¨t²Î
- win8
- ³nÅ骩¥»
- office2003
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2013-1-24
- ³Ì«áµn¿ý
- 2025-1-26
|
[µo°Ý] ¦p¦ó¨Ï¥ÎVBA¶}±Ò¥t¥~¤@ÓEXCELÀɮסA¦ý¤£±Ò°Ê¹ï¤è¥¨¶°
½Ð°Ý¤@¤U¡A¦]¬°§Ú·Q°µ¤@Ó ¸ê®Æ¸ü¤J¾¹ªº¥\¯à¡A§Ú¨âÓ¸ê®Æ§¨³£¦³VBAªºµ{¦¡
§Ú²{¦b·Q¥ÎB¸ê®Æ·íBASE¡A¸ü¤J¦ÜAÀɮפ¤pºâ
¦ý¦]¬°BÀÉ®×¶}±Ò®É·|±Ò°Ê¹ï¸Ü¥¨¶°¡A©Ò¥H§Ú¦bAÀɮפ¤³]©w¤FÃö³¬¥¨¶°¡A¨Ó°±¤îBÀɮתº¹ï¸Ü¥¨¶°
¦ý¤]¾ÉP§ÚAÀÉ®×¥¨¶°¤]³Q°±¤î¤F¡A§Ú¸Ó¦p¦ó³B²z
ttt.zip (20.5 KB)
Sub test()
Dim mybook As Workbook
Dim mysh As Worksheet, dtsh As Worksheet
Dim cell As Range
Dim num As Long
Dim secAutomation As MsoAutomationSecurity
Set mybook = ThisWorkbook
Set mysh = mybook.ActiveSheet
mypath = mybook.Path & "\"
dtfile = Dir(mypath & "*.xls")
r = 2
Do Until dtfile = ""
If dtfile <> mybook.Name Then
ck = ""
For Each wb In Workbooks
If wb.Name = dtfile Then ck = "Y"
Next wb
secAutomation = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable '------Ãö³¬¥¨¶°
If ck = "" Then Workbooks.Open mypath & dtfile
Application.AutomationSecurity = secAutomation '-----------------¥¨¶°±Ò¥Î
Set dtsh = Workbooks(dtfile).ActiveSheet
Workbooks(dtfile).Sheets(1).Range("a11:x850").Copy '½Æ»s B.xls Sheet1ªº a1¨ìc3
Windows(mybook.Name).Activate
Sheets(1).Select
Sheets(1).Range("a11").Activate
ActiveSheet.Paste
r = r + 1
End If
If dtfile <> mybook.Name Then
Workbooks(dtfile).Close savechanges:=False
End If
dtfile = Dir
Loop
End Sub |
|