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

[µo°Ý] µ{¦¡F8¥i¥HF5´N·í¾÷¡A¥H¤ÎÃö³¬WORD.EXE

[µo°Ý] µ{¦¡F8¥i¥HF5´N·í¾÷¡A¥H¤ÎÃö³¬WORD.EXE

¥»©«³Ì«á¥Ñ iceandy6150 ©ó 2020-3-31 23:13 ½s¿è

¤j®a¦n¡A§Ú¼g¤F¤@­Ó«ö¶s¡A«ö¤U¥h¤§«á¡A¥D­n¥\¯à¬O¶}±Ò¤@­ÓWORDÀÉ
µM«á¶i¦æ¦X¨Ö¦C¦L¡A¨Ã¦X¨Ö¦C¦L¨ì·sÀÉ®×
µ¥¨Ï¥ÎªÌ¦C¦L«á¡AÃö±¼·sÀɮ׸ò­ìÀÉ®×
(³oÃ䥻¨Ó·Q­n¼g¦¨¡A·sÀÉ®×·|¦Û°Ê¦C¦L¡AµM«áÃö±¼©Ò¦³WORDÀÉ)
(¦ý¬O©È¨Ï¥ÎªÌªº¦Lªí¾÷¥i¯à¤£ºÉ¬Û¦P¡A¦]¦¹§@½})

«e­±·|¥ýÀˬd¬O§_¤w¸g¶}±ÒWORDÀÉ
¦³¶}´N¸ß°Ý¬O§_Ãö±¼WORD¡A©ÎªÌ¤£¦sÀɱj¨îÃö³¬

°ÝÃD¦b¡A¨C¤@¦¸¨Ï¥ÎªÌ¦C¦L«á¡AÃö±¼WORD·sÀɮ׸ò­ìÀɮ׫á
¨ä¹ê¡i¤u§@ºÞ²z­û¡j¸Ì­±¡AWORD.EXE³o­Óµ{§ÇÁÙ¬O¦s¦b

µM«á¡i¥ýÀˬd¬O§_¤w¸g¶}±ÒWORDÀÉ¡j³oÃä¡A¦pªGF8³v¨B°õ¦æ¡A¬O¨S°ÝÃDªº
¦pªGª½±µ«ö¤U«ö¶s°õ¦æ¡A´N·|¥d¦í(F5ª½±µ°õ¦æ´N·|¥d¦í)
¸Ñ¨M¿ìªk¬O¥h¡i¤u§@ºÞ²z­û¡j¸Ì­±¡A§âWORD.EXE³o­Óµ{§ÇÃö±¼¡A¤~¯à¥¿±`¶]
  1. Private Sub CommandButton2_Click()
  2. '====°»´ú¬O§_¦³¶}±Ò¤¤ªºWORDÀÉ¡A¨Ã¿ï«h¬O§_¦sÀÉÃö³¬====

  3. Dim WordApp As Object, Doc As Object
  4. Dim box
  5. On Error GoTo Skip  '³]¸m¥X¿ù¸õÂà¦ì¸m
  6. Set WordApp = GetObject(, "word.application")  'Àò¨ú²Ä¤@­Óword¶iµ{
  7. Do While Not WordApp Is Nothing  '¦pªG¦¨¥\Àò¨ú¶iµ{,«h¶i¤J°j°é¾Þ§@
  8.     With WordApp
  9.         If .Documents.Count > 0 Then  '¦pªG¶iµ{¤¤¦³¥´¶}ªº¤åÀÉ

  10.             MsgBox ("°»´ú¨ì¦³©|¥¼Ãö³¬ªºWORDÀÉ®×")
  11.             box = MsgBox("±z­nÂ÷¶}¥»µ{¦¡¡A¥ý±NWORDÀÉ®×Ãö³¬?" + Chr(13) + "¡i¬O¡jÂ÷¶}¥»µ{¦¡" + Chr(13) + "¡i§_¡j¤£¦sÀɪ½±µÃö³¬WORD", 4, "­«­n°T®§")

  12.             If box = 6 Then
  13.                Exit Sub

  14.             Else

  15.             For Each Doc In .Documents  '°j°é¦U­Ó¥´¶}ªº¤åÀÉ
  16.                 Doc.Close False  'Ãö³¬¤åÀɨ䣫O¦s(ª`:·Q«O¦sªº¸Ü,±N«á­±ªº°Ñ¼Æ§ï¬°True)
  17.             Next Doc

  18.             End If

  19.         End If
  20.         .Quit  'Ãö³¬·í«eªºword¶iµ{ <<<<<<³oÃä¦pªGF8°õ¦æ¡A¬O¥i¥H¦¨¥\Ãö³¬¤u§@ºÞ²z­û¤¤ªºWORD.EXEªº
  21.     End With
  22.     Set WordApp = GetObject(, "word.application")  'Àò¨ú¤U¤@­Óword¶iµ{
  23. Loop
  24. Skip:
  25.     Set Doc = Nothing  'µ²§ô©Î¥X¿ù¸õÂà¦Ü¦¹,²MªÅÅܼƱM®×
  26.     Set WordApp = Nothing
  27. '================================

  28. Dim wdObj As Object
  29. Dim strXls As String,  strSQL As String
  30. Dim a, b


  31. a = ThisWorkbook.Path  '¦¹EXCELÀɮצs©ñ¦ì¸m
  32. b = ThisWorkbook.Name  'b¬°ÀɦW
  33. strXls = a & "\" & b   '¦¹EXCELÀɮק¹¾ã¸ô®|¤ÎÀɦW


  34. Set wdObj = CreateObject("Word.Application") '·|¥ý§â©Ò¦³WORD³£Ãö±¼¡A©Ò¥H¥ÎCreat ¤£¥ÎGet
  35. Set wdObj = New Word.Application '±Ò°ÊWord
  36. wdObj.Visible = True
  37. wdObj.Documents.Open (a & "\¦C¦L.docx")


  38. With wdObj   '¨Ï¥ÎWith«á´N¥¿±`¤F

  39.      '³oÃä¥H¤U¬O¥ÎWORD¿ý»s¥¨¶°±o¨ìªº¦X¨Ö¦C¦L¼gªk
  40.     .ActiveDocument.MailMerge.OpenDataSource Name:= _
  41.         strXls, ConfirmConversions:=False, _
  42.         ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
  43.         PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
  44.         WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
  45.         Connection:= _
  46.         "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=strXls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locki" _
  47.         , SQLStatement:="SELECT * FROM `¤u§@ªí1", SQLStatement1:="", SubType:= _
  48.         wdMergeSubTypeAccess
  49.         
  50.     .ActiveDocument.MailMerge.Fields.Add Range:=.ActiveDocument.Tables(1).Cell(2, 1).Range, Name:="¸¹½X"
  51.    
  52.     .CommandBars("Mail Merge Panes").Visible = False
  53.    
  54.     With .ActiveDocument.MailMerge
  55.         .Destination = wdSendToNewDocument
  56.         .SuppressBlankLines = True
  57.         With .DataSource
  58.             .FirstRecord = wdDefaultFirstRecord
  59.             .LastRecord = wdDefaultLastRecord
  60.         End With
  61.         .Execute Pause:=False
  62.     End With
  63.    
  64. End With

  65. Set wdObj = Nothing

  66. MsgBox ("¦C¦L«á¡AÃö³¬WORDÀɮ׮ɡA°O±o³q³q¡i¤£­nÀx¦s¡j")
  67. MsgBox ("³Ì«á¤£¦L¤F¡A°O±o°õ¦æ¡i²M°£­I´ºWORDµ{¦¡¡j")

  68. End Sub
½Æ»s¥N½X
¨D±Ï¦U¦ì¡AÁÂÁÂ
¦X¨Ö¦C¦L´ú¸Õ.rar (34.5 KB)
«¢Åo~¤j®a¦n§r

        ÀR«ä¦Û¦b : §Ñ¥\¤£§Ñ¹L¡A§Ñ«è¤£§Ñ®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD