ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¨D§U«Ø¥ß°j°éÀ³¥Î

¦^´_ 10# linsurvey2005

¸Õ¸Õ¬Ý³o¼Ë¬O¤£¬O§A­nªº
  1. Sub Selection_Copy()
  2. Dim fs$, SRng, SourceWb As Workbook
  3. fs = Application.GetOpenFilename("Excel ÀÉ®×(*.xls),*.xls")
  4. Set SourceWb = Workbooks.Open(fs)
  5. k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)
  6. If TypeName(k) = "Boolean" Then SourceWb.Close 0: Exit Sub
  7. Set nwb = Workbooks.Add
  8. With nwb.Sheets(1)
  9. .Activate
  10. r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
  11. If IsArray(k) Then
  12. .Cells(r, 1).Resize(UBound(k, 1), UBound(k, 2)) = k
  13. Else
  14. .Cells(r, 1) = k
  15. End If
  16. yn = MsgBox("¬O§_Ä~Äò", vbYesNo): GoTo 10
  17. Do Until yn <> 6 Or TypeName(k) = "Boolean"
  18. r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
  19. If IsArray(k) Then
  20. .Cells(r, 1).Resize(UBound(k, 1), UBound(k, 2)) = k
  21. Else
  22. .Cells(r, 1) = k
  23. End If
  24. yn = MsgBox("¬O§_Ä~Äò", vbYesNo)
  25. 10
  26. If yn = 6 Then SourceWb.Activate: k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)
  27. Loop
  28. nwb.Activate
  29. DoEvents
  30. myfilename = Format(Date, "yymmdd") & "-Tilt-PDA.xls"
  31. Application.SendKeys myfilename, True
  32. sf = Application.GetSaveAsFilename("E:\")
  33. If sf <> False Then nwb.SaveAs sf
  34. SourceWb.Close 0
  35. End With
  36. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦nÆg~³oºØ¦³±ÐµL²\ªººë¯«(¤­Åé§ë¦a)
µ{¦¡½Xªº®ÄªG¦³¦p99.99¯Âª÷
À~¦º§Ú¤F~¤Ó±j¤F
¦A¦¸¸ß°Ý
If TypeName(k) = "Boolean" Then SourceWb.Close 0: Exit Sub
³o¥ySourceWb.Close 0  ¬O¥Î¨ÓÃö±¼  ¶}±ÒªºÀɮ׶Ü?

myfilename = Format(Date, "yymmdd") & "-Tilt-PDA.xls"
­ì¨Ó¥y¤l³o¼Ë¤l´N¥i¥H¤F
µ¥§Ú¿n¤À¥R¨¬§Ú´N¥h¤U¸ü¦Ñ®vªº"¤@¨Çvba±`¥Î»yªk½d¨Ò"
±µÄ²VBA§Ö2¦~¤F¨S°ò¥»©³¤l
«Ü¦hªF´ê¦è´êªºµ{¦¡½X
¸Ó¬O­n¥¿­±±µÄ²ªº®É­Ô¤F
¥[¤J½×¾Â«Ü¶}¤ß
·PÁ¦Ѯv¤£§[«ü¾É
¥H¤W
¶}¤ß¾Ç²ß,¾Ç²ß«Ü¶}¤ß

TOP

¦^´_ 11# Hsieh


¦Ñ®v¦n
°õ¦æ¸ê®Æ¿ï¨úªº®É­Ô¡A«öctrl+"A1:E50","G1:H50"
¸ê®ÆÅã¥Ü¦X¨Ö¬°A1:C50,G1:H50(D1:E50ªº¸ê®Æ¤w³QG1:H50»\¹L)
§Ú·QÅý¸ê®Æ¦X¨Ö¬°A1:E50,G1:H50
À°¦£¸Ñ´b
¶}¤ß¾Ç²ß,¾Ç²ß«Ü¶}¤ß

TOP

¦^´_ 12# linsurvey2005

³o¥ySourceWb.Close 0  ¬O¥Î¨ÓÃö±¼  ¶}±ÒªºÀɮ׶Ü?

SourceWb.Close 0 -> SourceWb.Close False ( ÀÉ®×Ãö³¬:  ¤£Àx¦sÀÉ®×)
SourceWb.Close 1 -> SourceWb.Close True   (ÀÉ®×Ãö³¬:  Àx¦sÀÉ®×)

¦^´_ 13# linsurvey2005

·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 14# GBKEE

ÁÂÁ¤j¤j¤p¸Ñ
¥t¦³¤@¤j¥¼¸Ñ¡A´N¬O 11# µ{¦¡¸Ì­±ªº¿ï¨ú¸ê®Æ¤£¯à¨Ï¥Îctrl+¬Û¹ïÀx¦s®æ¼Æ¥Ø
¶}¤ß¾Ç²ß,¾Ç²ß«Ü¶}¤ß

TOP

¦^´_ 15# linsurvey2005
¤£¤F¸Ñ§Aªº²[¸q: 13# ¸ê®ÆÅã¥Ü¦X¨Ö¬°A1:C50,G1:H50(D1:E50ªº¸ê®Æ¤w³QG1:H50»\¹L),§Ú·QÅý¸ê®Æ¦X¨Ö¬°A1:E50,G1:H50
ctrl+¬Û¹ïÀx¦s®æ¼Æ¥Ø => ¿ï¨ú¦h­«ªº½d³ò
­×§ïHsieh¶Wª©  11#ªºµ{¦¡½X¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Selection_Copy()
  3.     Dim fs$, SRng As Range, SourceWb As Workbook, r As Integer, k As Range, myfilename As String
  4.     On Error Resume Next
  5.     fs = Application.GetOpenFilename("Excel ÀÉ®×(*.xls),*.xls")
  6.     Set SourceWb = Workbooks.Open(fs)
  7.     Set k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)       'ª«¥ó:Range
  8.     If Err.Number <> 0 Then GoTo 10                                         '¨ú®øInputBoxªº¿é¤J->k¤£¬°ª«¥ó·|¦³¿ù»~
  9.     With Workbooks.Add.Sheets(1)                                            'ª«¥ó:·s¼W¬¡­¶Ã¯ªº²Ä1­Ó¤u§@ªí
  10.         '·s¼W¬¡­¶Ã¯®É,§@¥Î¤¤ªº¬¡­¶Ã¯·|²¾¨ì¦¹·s¼W¬¡­¶Ã¯
  11.         SourceWb.Activate                                                    '§@¥Î¤¤ªº¬¡­¶Ã¯:¦¹¬¡­¶Ã¯
  12.         Do
  13.             For Each SRng In k.Areas                                         'Areas ¶°¦X¡A¦¹¶°¦X¥Nªí¦h­«½d³ò¤¤ªº©Ò¦³½d³ò
  14.                 r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
  15.                 .Cells(r, 1).Resize(SRng.Rows.Count, SRng.Columns.Count) = SRng.Value
  16.             Next
  17.             If MsgBox("¬O§_Ä~Äò", vbYesNo) = vbNo Then Exit Do
  18.             Set k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)
  19.             If Err.Number <> 0 Then Exit Do                                   '¨ú®øInputBoxªº¿é¤J->k¤£¬°ª«¥ó·|¦³¿ù»~
  20.         Loop
  21.         .Activate
  22.         DoEvents
  23.         myfilename = Format(Date, "yymmdd") & "-Tilt-PDA.xls"
  24.         Application.SendKeys myfilename, True
  25.        fs = Application.GetSaveAsFilename("E:\")
  26.         If fs <> False Then .Parent.SaveAs fs
  27.         .Parent.Close 0
  28.     End With
  29. 10:
  30.     SourceWb.Close 0
  31. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 16# GBKEE


    ¤j¤j¦n µLªk¶¶§Q¿ï¨ú¸ê®Æ §Ú»¡©ú¤@¤Uµ{¦¡½X¤º®e

²Ä¤@¨BÆJ ¬O¥ýÂI¿ï©Ò­nªºExcelÀÉ®×
²Ä¤G¨BÆJ ¶}©l¿ï¨ú©Ò­nªº¸ê®Æ(¦]¬°¸ê®Æ¦³²Ö¿n­È¡A·Q§â²Ä¤@µ§ ¸ò ²Ä¥|µ§ ¸ò ²Ä¤Cµ§¸ê®Æ¤@°_¿ï¨ú)
²Ä¤T¨BÆJ ¿ï¾Ü¸ê®Æ¤£¨¬ªº¸Ü¥i¥HÄ~Äò¶i¦æ¸ê®Æ¿ï¨ú(¦A¦¸¿ï¨úªº¸ê®Æ»Ý­n°ïÅ|¨ì¥ý«e§ì¨úªº)
²Ä¥|¨BÆJ ¶i¦æ¦sÀÉ

·PÁ¦³¤T
¶}¤ß¾Ç²ß,¾Ç²ß«Ü¶}¤ß

TOP

¦^´_ 17# linsurvey2005

[  ¬Ýªº¤@ÀYÃú¤ô  ]
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 18# GBKEE


¤j¤j»¡ªº¯u¬O¨ì¨ý
§Úª½±µ¤W¶Çµ¹¤j¤j¹L¥Ø§Y¥iª¾¹D°ÝÃD¥X¦b­þ¸Ì
ÀÉ®×µ{¦¡½X¦³²K¥[­Ó¤Hªººc·Q¡A·PÁÂ

Tilt.zip (17.59 KB)

¶}¤ß¾Ç²ß,¾Ç²ß«Ü¶}¤ß

TOP

¦^´_ 19# linsurvey2005
ÁÙ¬O [  ¬Ýªº¤@ÀYÃú¤ô  ],©|¯Ê: 1.¸ê®ÆÀÉ,2.§¹¦¨ÀÉ(§Aªººc·Q) ªº½d¨Ò.
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¹ï¤÷¥À­nª¾®¦¡A·P®¦¡B³ø®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD