2012-09-18 22 views
5

Belirli bir dizinde .docx ve/veya .xlsx dosyalarının tümünü açması beklenen bir VBA Alt (aşağıda) yazdım. bul/değiştir işlemini gerçekleştirin ve sonra orijinal dosyaların üzerine yenilerini yazın. Bu, her zaman bir .xlsx dosyası için çalıştırıldığı gibi çalışır ve "_Global" nesnesinin "Yöntem" Sayfaları "hatasını atar" hatası "her zaman başarısız oldu. Bu, VBA'da programlamada ilk denememdir, bu yüzden muhtemelen göremediğim çok basit bir cevap vardır. Bu kod satırında kırar:"Metot '_global' nesnesinin 'çalışma sayfaları' hatası" diğer her çalıştırmada hata "

teşekkür "For i = 1 oWB.Sheets.Count için"

Option Explicit 
Public SearchPhrase As String 
Public ReplacePhrase As String 

Sub StringReplacer() 

Dim fd As FileDialog 
Dim PathOfSelectedFolder As String 
Dim SelectedFolder 
Dim SelectedFolderTemp 
Dim MyPath As FileDialog 
Dim fs 
Dim ExtraSlash As String 
ExtraSlash = "\" 
Dim MyFile 
Dim rngTemp As Range 
Dim MinExtensionX As String 
Dim arr() As Variant 
Dim lngLoc As Variant 
Dim oExcel As New Excel.Application 
Dim oWB As Excel.Workbook 
Dim ws As Worksheet 
Dim i As Integer 
Dim doc As String 
Dim xls As String 
Dim redlines As String 

'get desired file extensions from checkboxes in GUI and put them into an array 
doc = ActiveDocument.FormFields("CKdocx").CheckBox.Value 
If doc = True Then 
    doc = "docx" 
Else 
    doc = " " 
End If 
xls = ActiveDocument.FormFields("CKxlsx").CheckBox.Value 
If xls = True Then 
    xls = "xlsx" 
Else 
    xls = " " 
End If 
arr = Array(doc, xls) 

'set redlines variable from redlines checkbox in GUI 
redlines = ActiveDocument.FormFields("CKredlines").CheckBox.Value 

'Prepare to open a modal window, where a folder is selected 
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker) 
With MyPath 
    'Open modal window 
    .AllowMultiSelect = False 
    If .Show Then 
     'The user has selected a folder 
     'Loop through the chosen folder 
     For Each SelectedFolder In .SelectedItems 
      'record name of the selected folder 
      PathOfSelectedFolder = SelectedFolder & ExtraSlash 
      Set fs = CreateObject("Scripting.FileSystemObject") 
      Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder) 
      'Loop through the files in the selected folder 
      For Each MyFile In SelectedFolderTemp.Files 
       'grab extension of file 
       MinExtensionX = Mid(MyFile.Name, InStrRev(MyFile.Name, ".") + 1) 
       'check to see if extension of the file is in the accepible list 
       If IsInArray(MinExtensionX, arr) Then 

        If MinExtensionX = "docx" Then 
         'Open the Document (.docx) 
         Documents.Open FileName:=PathOfSelectedFolder & MyFile.Name 
         'turn off "track changes" if that option was selected 
         If redlines = True Then 
         ActiveDocument.TrackRevisions = False 
         ActiveDocument.Revisions.AcceptAll 
         End If 
         'replace all keyphrases (.docx) 
         Set rngTemp = ActiveDocument.Content 
         With rngTemp.Find 
          .ClearFormatting 
          .Replacement.ClearFormatting 
          .MatchWholeWord = True 
          .Execute FindText:=SearchPhrase, ReplaceWith:=ReplacePhrase, Replace:=wdReplaceAll 
         End With 
         'save and close the document (.docx) 
         Application.DisplayAlerts = False 
         ActiveDocument.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name 
         ActiveDocument.Close 
         Application.DisplayAlerts = True 
        End If 

        If MinExtensionX = "xlsx" Then 
         'open the document (.xlsx) 
         oExcel.Visible = True 
         Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name) 
         oWB.Activate 
         'replace all keyphrases sheet by sheet(.xslx) 
         For i = 1 To oWB.Sheets.Count 
          Sheets(i).Activate 
          ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False 
         Next i 
         'save and close the document (.xslx) 
         Application.DisplayAlerts = False 
         oWB.SaveAs FileName:=PathOfSelectedFolder & MyFile.Name 
         oWB.Close 
         Application.DisplayAlerts = True 
        End If 

       End If 
      Next 
     Next 
    End If 
End With 

'close teh excel application and clean up 
oExcel.Quit 
Set oExcel = Nothing 

End Sub 

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) 
End Function 

cevap

2

sorun bu hat ile seyir için: Sheets(i).Activate oWB.Sheets.Activate

değiştirin Çalışacağınız diğer sorunlar nedeniyle, tüm doğru başvuruları içeren ".xlsx" dosyaları için tüm ifadenizi yeniden yazdım.

If MinExtensionX = "xlsx" Then 
    'open the document (.xlsx) 
    oExcel.Visible = True 
    Set oWB = oExcel.Workbooks.Add(PathOfSelectedFolder & MyFile.Name) 
    oWB.Activate 
    'replace all keyphrases sheet by sheet(.xslx) 
    For i = 1 To oWB.Sheets.Count 
     oWB.Sheets(i).Activate 'Must provide the workbook or Sheets() fails 
     oWB.ActiveSheet.Cells.Replace What:=SearchPhrase, Replacement:=ReplacePhrase, LookAt:=xlPart, MatchCase:=False 'Must provide the workbook or tries to find activesheet in calling application. 
    Next i 
    'save and close the document (.xslx) 
    oExcel.DisplayAlerts = False 'Using Application instead of oExcel affects calling app instead of Excel 
    oWB.SaveAs Filename:=PathOfSelectedFolder & MyFile.Name 
    oWB.Close 
    oExcel.DisplayAlerts = True 'Using Application instead of oExcel affects calling app instead of Excel 
End If 
+0

Teşekkürler Daniel! Bu çok açık ve ek ipuçlarını takdir ediyorum. Önerilerime göre kodumu güncelleyeceğim. – user1678035

0

Bu belirli bir sorunu olmayabilir, ama benim durumumda geçmişte olmuştur: Ben de değiştirdim niçin uzun soluklu bir yorum ekledi. Sheets'u kullanarak, Worksheets'un içermediği diğer sayfa türlerine ihtiyacınız olmadığında birçok soruna neden olduğu kanıtlanmıştır. Worksheets ile tüm Sheets başvuruları değiştirmeyi deneyin.

İlgili konular