ورڈ میں بیرونی فائل کی فہرست سے تلاش و تبدیل میں مدد درکار ہے

زہیر عبّاس

محفلین
جی، میکرو میں ایرر تھے، میں نے وقت ملنے پر ابھی ٹھیک کر دیا ہے۔

کوڈ:
Sub Main()
Dim xl As Object 'Excel.Application
Dim wb As Object 'Excel.Workbook
Dim ws As Object 'Excel.Worksheet
Dim rng As Object 'Excel.Range
Dim cl As Object  'Excel.Range
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("D:\list.xlsx") '## Modify as needed
Set ws = wb.Sheets(1) '##Modify as needed
Set rng = ws.Range("a1:a2")
For Each cl In rng
    Call Macro5(cl.Value, cl.Offset(0, 1).Value)
Next
End Sub

Sub Macro5(findText$, replaceText$)
'
' Macro5 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute
End Sub

ایکسل فائل کے کالم اے میں الفاظ رکھیں اور کالم بی میں ان کے متبادل۔
a1:a2 میں a2 کی جگہ آخری لفظ کا کالم نمبر لکھیں۔

محمد تابش صدیقی جناب اس میکرو کا استعمال کرتے ہوئے ایک اور مسئلہ آگیا ہے کہ جب تلاش کرنے والے جملہ 255 حروف سے زائد ہوتا ہے تو runtime-error-5854 آجاتا ہے۔ اس کا کیا علاج ہے۔ انٹرنیٹ سے تلاش کرتے ہوئے یہ ویب سائٹ ملی ہے جس میں اس کا کچھ حل بتاتا گیا ہے تاہم اس کوڈ کو میں موجودہ میکرو میں کیسے سیٹ کروں نہیں معلوم۔ اگر آپ کو موقع ملے اور کچھ فرصت ہو تو کیا اس سلسلے میں مدد فرما سکتے ہیں کوڈ یہ ہے:
کوڈ:
Private Sub SearchAndReplace(search As String, replace As String)

Dim i As Integer
Dim chunks As Integer
Dim chunk As String

Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst ' Go to the start of the document

With Selection.Find
    .ClearFormatting
    .MatchCase = True
    .MatchWholeWord = True

    ' We get error 5854 if the replacement text is greater than 255 characters, so need to work around
    ' How many 250 character "chunks" are there in the replacement text?
    chunks = Round(Len(replace) / 250, 0)                   ' Use 250 to allow for {1}, etc.
    If Len(replace) Mod 250 > 0 Then chunks = chunks + 1      ' Workaround because there's no Ceiling()

    If chunks = 1 Then
        .Execute FindText:="{" & search & "}", ReplaceWith:=replace, replace:=wdReplaceAll
    Else

        ' Replace existing replacement variable (e.g. {Text}) the first chunk's replacement variable (i.e. {1})
        .Execute FindText:="{" & search & "}", ReplaceWith:="{1}", replace:=wdReplaceAll

        ' Replace the text in chunks of less than 255 characters
        For i = 1 To chunks

            ' Get the
            chunk = Mid(replace, ((i - 1) * 250) + 1, 250)

            ' Add the replacement variable for the next chunk to the end of the string
            If i < chunks Then chunk = chunk & "{" & (i + 1) & "}"

            .Execute FindText:="{" & i & "}", ReplaceWith:=chunk, replace:=wdReplaceAll
        Next i

    End If
End With

End Sub
 
میرے میکرو میں اِس کوڈ کو اپنے تلاش کئے ہوئے کوڈ سے تبدیل کر دیں:
کوڈ:
Sub Macro5(findText$, replaceText$)
'
' Macro5 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Execute
End Sub

اور جہاں میں نے اوپر والے کوڈ کو کال کیا تھا، وہاں فنکشن کا نام تبدیل کر دیں:
Call Macro5(cl.Value, cl.Offset(0, 1).Value)
کو اس طرح تبدیل کر دیں
Call SearchAndReplace(cl.Value, cl.Offset(0, 1).Value)
 

زہیر عبّاس

محفلین
میرے میکرو میں اِس کوڈ کو اپنے تلاش کئے ہوئے کوڈ سے تبدیل کر دیں:
جناب آپ کے بتائے ہوئے طریقے کار پر عمل کرتے ہوئے پچھلے کوڈ کو نئے سے تبدیل کردیا۔ تاہم اب بھی وہی رن ٹائم ایرر5854 آرہا ہے۔ اور ڈی بگ اس لائن کو شو کررہا ہے :
کوڈ:
.Execute findText:="{" & search & "}", ReplaceWith:="{1}", replace:=wdReplaceAll
کوئی حل؟
 
جناب آپ کے بتائے ہوئے طریقے کار پر عمل کرتے ہوئے پچھلے کوڈ کو نئے سے تبدیل کردیا۔ تاہم اب بھی وہی رن ٹائم ایرر5854 آرہا ہے۔ اور ڈی بگ اس لائن کو شو کررہا ہے :
کوڈ:
.Execute findText:="{" & search & "}", ReplaceWith:="{1}", replace:=wdReplaceAll
کوئی حل؟
میں نے یہ سمجھتے ہوئے کہ آپ کو درست حل ملا ہے، اس کوڈ کو اپنے میکرو میں ضم کر دیا تھا۔ ابھی دفتر میں ہوں خود اس کو ٹیسٹ نہیں کر سکتا۔ آپ رن ٹائم ایرر5854 کو ذرا گوگل پر تھوڑا اور کھنگالیں۔
 
برادرم ابن سعید اگر آپ اس سلسلے میں کچھ مدد کرسکیں تو انتہائی ممنون ہوں گا۔
ونڈوز، مائکروسافٹ آفس، اور اس متعلقہ اسکرپٹنگ سے ہمارا پالا نہیں پڑتا ہے اور نہ ہی ہم ان چیزوں کو اپنے آفس یا ذاتی کمپیوٹر میں رکھتے ہیں اس لیے براہ راست کوئی مدد کر پانے سے قاصر ہیں۔ :) :) :)
 

arifkarim

معطل
نہیں جناب اس سے کام نہیں بن رہا۔
کیا مطلب؟ آپنے ریپلیس والا آپشن استعمال کیا؟ اسمیں میکرو والی کوئی لمٹ نہیں ہے:
b962.gif

کوئی سوال ہو تو محترم ابرارحسین سے رابطہ کر لیں
 
مدیر کی آخری تدوین:
Top