جستجو

ترفندهای کامپیوتری

حضرت علی (ع): «زَکوةُ العِلمِ نَشرُهُ؛ زکات علم نشر آن است».
وبلاگ "ترفندها" (سایت پی‌سی‌ترفند) برای عمل به این حدیث شریف و با هدف ارتقاء دانش و مهارت‌های مرتبط با رایانه در ۳۰ مهرماه ۱۳۹۱ ایجاد شده است. به امید آنکه مفید واقع شود.
ربات پی‌سی‌ترفند در تلگرام:
telegram.me/pctarfand_bot

خلاصه آمار

تبليغات

پربحث ترين ها

استخراج اطلاعات از چندین فایل ورد و انتقال آن به یک فایل اکسل

اکسل ورد ماکرونویسی

یکی از کاربران سوالی را با این مضمون مطرح کردند که "آیا می‌توان اطلاعات درون چندین فایل ورد با ساختار مشابه اما دارای اطلاعات متفاوت را بصورت خودکار درون یک فایل اکسل لیست کرد؟" بله چنین امکانی وجود دارد. در ادامه مطلب با پی‌سی‌ترفند همراه باشید تا با نحوه انجام اینکار آشنا شوید.

حالت اول) استخراج اطلاعات جدول موجود در فایل‌های ورد

فرض کنید ۱۰۰ فایل ورد دارید که دارای جدولی به فرم زیر هستند و شما می‌خواهید اطلاعات این جدول از تمام این فایل‌های ورد استخراج و در یک فایل اکسل لیست شود.

بهترین روش برای انجام اینکار، استفاده از کدنویسی ماکرو در نرم‌افزار اکسل است. بدین منظور یک فایل اکسل باز کنید. سپس کلیدهای Alt + F11 را فشار دهید یا از تب Developer قسمت code گزینه Visual Basic را انتخاب کنید. پنجره Microsoft Visual Basic  ظاهر می‌شود. در این پنجره از تب Insert گزینه Module را انتخاب نمائید.

در پنجره جدید باز شده کدهای زیر را کپی کنید.

Option Explicit
'pctarfand.ir & tarfandha.blog.ir'
Sub ImportWordTable()
Dim WS As Worksheet, i As Long, NextRow As Long
Dim FN As String, CellData As String, WordPath As String
Dim wrdApp As Object, wrdDoc As Object
Set WS = ActiveSheet
With WS
    'Path to word files.
    WordPath = "C:\Users\1"
    FN = Dir(WordPath & "\*.doc?")
    If FN <> "" Then
        On Error Resume Next
       'Get existing instance of Word if it exists.
       Set wrdApp = GetObject(, "Word.Application")
       If Err <> 0 Then
          'If GetObject fails, then use CreateObject instead.
            Set wrdApp = CreateObject("word.application")
        End If
        On Error GoTo 0
        'Test for wrdApp existance.
        If Not wrdApp Is Nothing Then
            i = 1
            Do
               'Open the work doc.
                Set wrdDoc = wrdApp.documents.Open(WordPath & "\" & FN)
                CellData = wrdDoc.Tables(1).Cell(1, 2).Range.Text
                WS.Cells(i, 1) = Left(CellData, Len(CellData) - 2)
                CellData = wrdDoc.Tables(1).Cell(2, 2).Range.Text
                WS.Cells(i, 2) = Left(CellData, Len(CellData) - 2)
                CellData = wrdDoc.Tables(1).Cell(3, 2).Range.Text
                WS.Cells(i, 3) = Left(CellData, Len(CellData) - 2)
                CellData = wrdDoc.Tables(1).Cell(1, 4).Range.Text
                WS.Cells(i, 4) = Left(CellData, Len(CellData) - 2)
                CellData = wrdDoc.Tables(1).Cell(2, 4).Range.Text
                WS.Cells(i, 5) = Left(CellData, Len(CellData) - 2)
                WS.Cells(i, 6) = FN
                wrdDoc.Close False                             
                FN = Dir
                i = i + 1
            Loop Until FN = ""
        End If
    End If
End With
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

توجه: فایل‌های ورد خود را درون یک پوشه قرار دهید و آدرس پوشه را در کد بالا، با آدرسی که در سطر ۱۰ درج شده است (C:\Users\1) جایگزین کنید. 
در پایان پس از کپی کردن کد فوق در پنجره Microsoft Visual Basic دکمه  یا کلید F5 را فشار دهید تا نتیجه زیر حاصل شود.

نکته ۱: ردیف اول بصورت دستی به فایل اضافه شده است و فونت بصورت دستی تغییر داده شده است.

نکته ۲: باید دقت شود که اکسل اطلاعات اولین جدول درون فایل‌های ورد را استخراج می‌کند. اگر می‌خواهید که اطلاعات جدول‌های بعد را استخراج کنید باید در کد ماکروی بالا بجای عدد ۱ در عبارت (wrdDoc.Tables(1 شماره جدول مورد نظرتان را قرار دهید.

اگر بخواهید اطلاعات آخرین جدول استخراج شود بجای عدد ۱ در عبارت (wrdDoc.Tables(1 از wrdDoc.Tables.Count استفاده کنید بصورت زیر:

wrdDoc.Tables(wrdDoc.Tables.Count)

منبع با تغییر: excelforum.com

 

حالت فوق یک حالت خاص می‌باشد که برای یک نوع جدول مشخص قابل استفاده است به‌طوری‌که در آن بصورت گزینشی برخی از سلول‌ها انتخاب و به فایل اکسل منتقل شده‌اند.

اگر به کدی نیاز دارید که جامع‌تر باشد به این سایت مراجعه کنید. با استفاده از این کد تمام سلول‌های درون جدول داخل فایل ورد به اکسل منتقل می‌شوند مشابه شکل زیر:

 

در کد دیگری که در این سایت قرار داده شده است جداول عینا به اکسل منتقل می‌شوند با حفظ فونت و بدون هیچ گونه جابجایی سلول‌ها. مشابه شکل زیر:

 

کدهای دیگری برای حالاتی مشابه حالت اول را در سایت‌های زیر مشاهده کنید:

۱- exceltrainingvideos.com

۲- vbaexpress.com


حالت دوم) استخراج اطلاعات داخل متن موجود در فایل‌های ورد

در اینحالت برای اینکه اطلاعاتی که قصد استخراج آن را داریم از سایر اطلاعات درون فایل ورد متمایز باشد باید اطلاعات مورد نظر دارای یک کاراکتر خاص باشند. مثلا در شکل زیر اطلاعات مورد نظر مقابل کاراکتر : قرار دارند و در انتها به اینتر ختم می‌شوند.

بنابراین در کد ماکروی زیر کاراکتر متمایز کننده ":" می‌باشد.

ابتدا یک فایل اکسل باز کنید. در ردیف اول عناوین اطلاعاتی که می‌خواهید از فایل‌های ورد استخراج شود را درج کنید (مثل شکل زیر) تا اکسل پس از جستجو و یافتن این عناوین در متن، اگر پس از آن‌ها ":" بود، اطلاعات بین ":" و اینتر را استخراج کند. 

سپس کلیدهای Alt + F11 را فشار دهید یا از تب Developer قسمت code گزینه Visual Basic را انتخاب کنید. پنجره Microsoft Visual Basic for applications window ظاهر می‌شود. در این پنجره از تب Insert گزینه Module را انتخاب نمائید. در پنجره جدید باز شده کدهای زیر را کپی کنید.

Option Explicit
'pctarfand.ir & tarfandha.blog.ir'
Sub UpdateData()
Application.ScreenUpdating = False
Dim StrFolder As String, StrFile As String, StrFnd As String, StrTxt As String
Dim wdApp As Object, wdDoc As Object, bStrt As Boolean
Dim WkSht As Worksheet, LRow As Long, LCol As Long, i As Long
Const wdFindContinue As Long = 1, wdReplaceAll As Long = 2
StrFolder = GetFolder
If StrFolder = "" Then Exit Sub
Set WkSht = ThisWorkbook.Sheets("Sheet1")
LRow = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Row
LCol = WkSht.Cells.SpecialCells(xlCellTypeLastCell).Column
'Test whether Word is already running'
On Error Resume Next
bStrt = False 'Flag to record if we start Word, so we can close it later'
Set wdApp = GetObject(, "Word.Application")
'Start Excel if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
'Record that we've started Excel
  bStrt = True
End If
On Error GoTo 0
StrFile = Dir(StrFolder & "\*.doc", vbNormal)
While StrFile <> ""
  LRow = LRow + 1
  Set wdDoc = wdApp.Documents.Open(Filename:=StrFolder & "\" & StrFile, AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
  'Do some pre-processing cleanup'
  With wdDoc.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
 End With
'Get the data for each defined Excel column'
  For i = 1 To LCol
    StrFnd = WkSht.Cells(1, i).Value
    With wdDoc.Range
      With .Find
        .ClearFormatting
        .Text = StrFnd & ":[!^13]@^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute
      End With
If .Find.Found = True Then
        'Parse the data'
        StrTxt = .Duplicate.Text
        If InStr(StrTxt, ":") > 0 Then
          StrTxt = Trim(Mid(StrTxt, InStr(StrTxt, ":") + 1, Len(StrTxt)))
        ElseIf InStr(StrTxt, "=") > 0 Then
          StrTxt = Trim(Mid(StrTxt, InStr(StrTxt, "=") + 1, Len(StrTxt)))
        End If
        'Update Excel'
        WkSht.Cells(LRow, i).Value = StrTxt
      End If
    End With
Next
  wdDoc.Close SaveChanges:=False
  StrFile = Dir()
Wend
If bStrt = True Then wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

در پایان پس از کپی کردن کد فوق، دکمه  یا کلید F5 را فشار دهید تا پنجره‌ای باز شود. در آن باید مکان پوشه‌ی فایل‌های ورد را مشخص کنید. پس از اینکار نتیجه‌ی زیر حاصل می‌شود:

منبع: vbaexpress.com

کد دیگری برای حالتی مشابه حالت دوم را در سایت‌ زیر مشاهده کنید:

techsupportforum.com


حالت سوم) استخراج اطلاعات وارد شده در فرم ساخته شده در فایل‌های ورد

برای اینحالت به سایت‌های زیر مراجعه کنید:

۱- techrepublic.com

۲- pcreview.co.uk

 

عضویت در خبرنامه:

نظرات (۱۳)

  1. با سلام و عرض تشکر بابت مطالب ارزنده ی شما
    سوالم این هست که برای کپی جدولی از یک سامانه که فیلدهای آن بصورت تکست باکس هست به اکسل بصورتی که بتوان روی آن عملیات ریاضی انجام داد یعنی بصورت تکست باکس کپی نشود چگونه است؟
    با تشکر
    • پاسخ:

      سلام
      با استفاده از ماکرو که در این سایت توضیح داده شده است می‌توان اینکار را انجام داد.
      موفق باشید.
  2. ضمن عرض سلام و ارادت

    یک نسخه از فرم مورد نظر را در تاریخ های 10و13و25و26 /1395/04 با موضوع راهنمایی در رابطه با انتقال جدول ورد به اکسل به آدرس داده شده ایمیل نمودم ولیکن تاکنون پاسخی دریافت ننموده ام  لطفاً راهنمایی بفرمائید.

    کمال تشکر و امتنان را دارم

    • پاسخ:

      سلام
      نمی‌دانم مشکل از کجاست که تا کنون فایلی از شما دریافت نکردم.
      فایل خود را در جایی آپلود کنید و لینک آنرا برای من در سایت قرار دهید.
  3. ضمن عرض سلام و ارادت

    یک نسخه از فرم مورد نظر را lمجدداً در تاریخ 1395/04/10 با موضوع راهنمایی در رابطه با انتقال جدول ورد به اکسل به آدرس داده شده ایمیل نمودم لطفاً راهنمایی بفرمائید.

    کمال تشکر و امتنان را دارم

    • پاسخ:

      سلام
      عرض کردم که من ایمیلی در تاریخ 95/4/110 دریافت نکردم لطفا دوباره ارسال کنید.
      tarfandha.blog@gmail.com
  4. ضمن عرض سلام و ارادت

    یک نسخه از فرم مورد نظر را در تاریخ 1395/04/10 با موضوع راهنمایی در رابطه با انتقال جدول ورد به اکسل به آدرس داده شده ایمیل نمودم لطفاً راهنمایی بفرمائید.

    کمال تشکر و امتنان را دارم

    • پاسخ:

      سلام
      من ایمیلی دریافت نکردم لطفا دوباره ارسال کنید.
      tarfandha.blog@gmail.com
  5. ضمن عرض سلام و اردادت ،

    فرم مورد نظر که قصد انتقال آن را به اکسل دارم بشرح ذیل می­باشد و در برخی مواقع نیز تعداد ستون­ها و یا ردیف­های آن بیش از جدول زیر می­باشد . در انتقال بصورت دستی ( کپی ، پیست) تاریخ­های مورد نظر بصورت برعکس وتاریخ میلادی نمایش داده می­شود .

    ردیف

    نام

    • پاسخ:

      فایل خود را از طریق ایمیل برای من ارسال کنید.
      tarfandha.blog@gmail.com
  6. ضمن عرض سلام  وخسته نباشید ؛

    کدهای مورد نظر برای اینکه بتوانم جداول ورود را عینا با حفظ فونت و بدون هیچ گونه جابجایی سلول‌ها به اکسل منتقل نمایم را از سایت معرفی شده دریافت نمودم ولیکن به هنگام اجرام پیام زیر نمایش داده می شود لطفاَ راهنمایی بفرمایید

    Compile error:

    ]Invalid outside procedure

    • پاسخ:

      سلام
      یک نمونه از فایل ورد خود را همراه با توضیحات برای من ارسال کنید.
  7. سلام

    ضمن عرض ارادت و خسته نباشید

    لطفاً راهنمایی بفرمائید آدرس دهی ورد  مدنظر را  درکدهای مورد نظر چگونه انجام دهم 

    • پاسخ:

      سلام
      در کد اول باید درون کد که با رنگ زرد مشخص شده است آدرس را وارد کنید.
      در کد دوم پس از اجرای کد، پنجره‌ای باز می‌شود که در آن باید مکان پوشه‌ی فایل‌های ورد را مشخص کنید.
      موفق باشید.

  8. سلام علیکم

    بابت کدهای مفید و کاربردی بالا متشکرم

     در صورت امکان کدهایی که بتوان جداول ورود را بتوان عینا با حفظ فونت و بدون هیچ گونه جابجایی سلول‌ها به اکسل منتقل نمود را نیز بگذارید  کمال تشکر وامتنان را دارم

    • پاسخ:

      سلام
      در انتهای حالت اول، تصویری قرار دارد که در متن بالای آن به سایتی اشاره شده است که کد مدنظر شما در آن سایت وجود دارد.
      موفق باشید.
  9. نوشتن یک متن با اعداد فارسی در یک مسیر نموداری درورد یا اکسل ؟
    اعداد نمودار ها رو تونستم با کد فارسی کنم ولی وقتی توضیحی واسه نمواد در زیرش مینویسم اعداد فارسی نمیشه و نمیشه روش کد دهی رو هم اعمال کرد چون گزینه ای واسه این کار نداره. راه جل جچیست ؟
    • پاسخ:

      سلام
      ظاهرا چنین امکانی وجود ندارد. باید با رسم یک تکس باکس متن همراه با اعداد فارسی را اضافه کنید.
      لطفا از این پس سوالتان را در صفحه مربوط با سوال مطراح کنید.
      موفق باشید.
  10. سلام مجدد
    چطور میشه بهش گفت که بعد از علامت موردنظر خط بعدیش رو هم بیاره توی اکسل؟
    تشکر فراوان
    • پاسخ:

      به حالت دوم مطلب بالا مراجعه کنید.
  11. سلام مجدد
    فرض کنید ما نمی دونیم که یه جدول چندمین جدول هست مثلا رونوشت های یک نامه که آخزین جدول هست و معلوم نیست که در فایلهای ما چند جدول وجود دارد چطور میشه بهش گفت بره روی آخرین جدول و این کارو انجام بده؟
    باتشکر
    • پاسخ:

      سلام
      در نکته ۲ حالت اول در مطلب بالا، به نحوه استخراج آخرین جدول اشاره شده است.
      از کد زیر نیز می‌توانید استفاده کنید.

      Sub CopyTables1()
      vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True)
      If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled
      Set appWord = CreateObject("Word.Application")
      On Error GoTo emergencyexit
      For Each Filename In vFiles
          Set docWord = Nothing
          Set docWord = appWord.Documents.Open(Filename)
          If Not docWord Is Nothing Then
              docWord.tables(docWord.tables.Count).Select
              appWord.Selection.Copy
              ActiveSheet.Paste
              docWord.Close
              ActiveSheet.UsedRange.Offset(ActiveSheet.UsedRange.Rows.Count).Resize(1, 1).Select
          End If
      Next
      emergencyexit:
      appWord.Quit
      End Sub


      پس از اجرای کد مطابق آموزش مطلب بالا، پنجره‌ای ظاهر می‌شود که باید فایل‌های مدنظرتان را انتخاب کنید تا کد اجرا شود.
      منبع: vbacodesamples.blogspot.com
      موفق باشید.

ارسال نظر

قبل از ارسال نظر به نکات زیر توجه کنید:

۱- با توجه با اینکه نظرات خصوصی شما امکان نمایش در سایت را ندارد، بنابراین هنگام ارسال نظر، گزینه "" را انتخاب نکنید. چون تنها راه پاسخگویی به آن از طریق ایمیل شما است که با توجه به مشغله کاری فرصت ارسال پاسخ از طریق ایمیل وجود ندارد.

۲- قبل از مطرح کردن سوالتان، مطلب فوق را با دقت مطالعه کنید. اگر پاسخ سوالتان را پیدا نکردید در سایت جستجو کنید، ممکن است در مطلب دیگر پاسخ سوالتان را پیدا کنید.

۳- تنها به سوالاتی پاسخ داده می‌شود که از نحوه حل آن‌ها اطلاع داشته باشم.

۴- نظراتی با مضمون زیر، صرفا تایید و نمایش داده می‌شود و به آن‌ها پاسخی داده نمی‌شود.

الف) در مورد پاسخ سوال شما اطلاعی نداشته باشم،

ب) پاسخ سوال شما در مطلب فوق وجود داشته باشد.

ارسال نظر آزاد است، اما اگر قبلا در بیان ثبت نام کرده اید می توانید ابتدا وارد شوید.
شما میتوانید از این تگهای html استفاده کنید:
<b> یا <strong>، <em> یا <i>، <u>، <strike> یا <s>، <sup>، <sub>، <blockquote>، <code>، <pre>، <hr>، <br>، <p>، <a href="" title="">، <span style="">، <div align="">
تجدید کد امنیتی
X بستن