ऑब्जेक्ट 'फ़ॉन्ट' ऑब्जेक्ट 'फ़ॉन्ट' विफल रहा

Question

मुझे अपने एक्सेल 2010 वीबीए कोड में शीर्षक त्रुटि संदेश मिल रहा है। मैंने this question और this question पर देखा है जो दोनों समान दिखते हैं, लेकिन नेटर इस मुद्दे को हल करने लगते हैं।

मेरे कोड वर्तमान कार्यपत्रक पर सभी सशर्त स्वरूपण के माध्यम से पार्स करता है और एक अन्य (नव निर्मित) कार्यपत्रक में पाठ के रूप में यह उदासीनता - अंतिम लक्ष्य एक लगभग समान कार्यपत्रक में उन्हीं की स्थिति लोड करने के लिए (इस प्रकार मैं है ' टी बेस वर्कशीट की प्रतिलिपि बनाएँ)।

कोड है:

Public Sub DumpExistingRules() 
'portions of the code from here: http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/ 

Const RuleSheetNameSuffix As String = "-Rules" 

    Dim TheWB As Workbook 
    Set TheWB = ActiveWorkbook 

    Dim SourceSheet As Worksheet 
    Set SourceSheet = TheWB.ActiveSheet 

    Dim RuleSheetName As String 
    RuleSheetName = SourceSheet.Name & RuleSheetNameSuffix 
    On Error Resume Next       'if the rule sheet doesn't exist it will error, we don't care, just move on 
    Application.DisplayAlerts = False 
    TheWB.Worksheets(RuleSheetName).Delete 
    Application.DisplayAlerts = True 
    On Error GoTo EH 

    Dim RuleSheet As Worksheet 
    Set RuleSheet = TheWB.Worksheets.Add 
    SourceSheet.Activate 
    RuleSheet.Name = RuleSheetName 

    RuleSheet.Range(RuleSheet.Cells(1, CellAddrCol), RuleSheet.Cells(1, OperatorCodeCol)).Value = Array("Cell Address", "Rule Type", "Type Code", "Applies To", "Stop", "Font.ColorRGB", "Formula1", "Formula2", _ 
      "Interior.ColorIndexRGB", "Operator Type", "Operator Code") 

    Dim RuleRow As Long 
    RuleRow = 2 
    Dim RuleCount As Long 
    Dim RptCol As Long 
    Dim SrcCol As Long 
    Dim RetryCount As Long 
    Dim FCCell As Range 
    For SrcCol = 1 To 30 
    Set FCCell = SourceSheet.Cells(4, SrcCol) 
    For RuleCount = 1 To FCCell.FormatConditions.Count 
     RptCol = 1 
     Application.StatusBar = "Cell: " & FCCell.Address 
     PrintValue RuleSheet, RuleRow, CellAddrCol, FCCell.Address 
     PrintValue RuleSheet, RuleRow, RuleTypeCol, FCTypeFromIndex(FCCell.FormatConditions.Item(RuleCount).Type) 
     PrintValue RuleSheet, RuleRow, RuleCodeCol, FCCell.FormatConditions.Item(RuleCount).Type 
     PrintValue RuleSheet, RuleRow, AppliesToCol, FCCell.FormatConditions.Item(RuleCount).AppliesTo.Address 
     PrintValue RuleSheet, RuleRow, StopCol, FCCell.FormatConditions.Item(RuleCount).StopIfTrue 
     If FCCell.FormatConditions.Item(RuleCount).Type <> 8 Then 
     PrintValue RuleSheet, RuleRow, Formula1Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula1, Len(FCCell.FormatConditions.Item(RuleCount).Formula1) - 1) 'remove the leading "=" sign 
     If FCCell.FormatConditions.Item(RuleCount).Type <> 2 And _ 
      FCCell.FormatConditions.Item(RuleCount).Type <> 1 Then 
      PrintValue RuleSheet, RuleRow, Formula2Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula2, Len(FCCell.FormatConditions.Item(RuleCount).Formula2) - 1) 'remove the leading "=" sign 
     End If 
     End If 
     RetryCount = 0 
RetryColor: 
     PrintValue RuleSheet, RuleRow, FontColorCol, "'" & GetRGB(FCCell.FormatConditions(RuleCount).Font.Color) 
     PrintValue RuleSheet, RuleRow, IntColorIdxCol, "'" & GetRGB(FCCell.FormatConditions.Item(RuleCount).Interior.Color) 
     If FCCell.FormatConditions.Item(RuleCount).Type = 1 Then 
     PrintValue RuleSheet, RuleRow, OperatorTypeCol, OperatorType(FCCell.FormatConditions.Item(RuleCount).Operator) 
     PrintValue RuleSheet, RuleRow, OperatorCodeCol, FCCell.FormatConditions.Item(RuleCount).Operator 
     End If 
     RuleRow = RuleRow + 1 
    Next 
    Next 

    RuleSheet.Rows(1).AutoFilter = True 

CleanExit: 
    If RuleRow = 2 Then 
    PrintValue RuleSheet, RuleRow, RptCol, "No Conditional Formatted cells were found on " & SourceSheet.Name 
    End If 
    On Error Resume Next 
    Set SourceSheet = Nothing 
    Set TheWB = Nothing 
    Application.StatusBar = "" 
    On Error GoTo 0 

    MsgBox "Done" 

    Exit Sub 

EH: 
    If Err.Number = -2147417848 Then 
    MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color 
    If RetryCount < 5 Then 
     RetryCount = RetryCount + 1 
     Resume RetryColor 
    Else 
     MsgBox "RetryCount = " & RetryCount 
     Resume Next 
    End If 
    Else 
    MsgBox "Error Number: " & Err.Number & vbCrLf & _ 
      " Description: " & Err.Description & vbCrLf & _ 
      "Cell Address: " & FCCell.Address & vbCrLf 
    Resume Next 
    End If 

End Sub 

प्रश्न में लाइन तुरंत RetryColor: लेबल निम्नलिखित एक है। जब कोड की उस पंक्ति को Unique Values सशर्त स्वरूपण नियम (यानी डुप्लिकेट हाइलाइट) के लिए निष्पादित किया जाता है, तो मुझे err.number = -2147417848' और err.description = "Method 'Color' of object 'Font' failed" मिलता है। कोड EH: पर गिरता है, पहले IF कथन में आता है, और बिना किसी समस्या के MsgBox प्रदर्शित करता है।

यह क्यों है कि कथन FCCell.FormatConditions(RuleCount).Font.Color पहली बार विफल रहता है, लेकिन त्रुटि हैंडलर में दूसरी बार निष्पादित करता है? एक बार जब मैंने MsgBox पर OK बटन क्लिक किया है, तो निष्पादन RetryColor: लेबल पर फिर से शुरू होता है, कथन सही ढंग से निष्पादित होता है, और सब अच्छा है।

---

---

यकीन है कि यह स्पष्ट है, अगर मैं EH: में

MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color 

लाइन बाहर टिप्पणी, कोड कभी अपने उत्पादन कार्यपत्रक में आरजीबी कोड outputting के बिना 5 बार त्रुटि, फिर पर जारी करने के लिए अपने मार्ग। यदि EH: (जैसा ऊपर दिखाया गया है) में MsgBox और .Font.Color अब मुख्य कोड में पढ़ा जाएगा और निष्पादन त्रुटि के बिना अपेक्षित जारी रहेगा।

---

---

अद्यतन: ऐसा लगता है, जबकि मैं कुछ और पर काम किया है कि इस कोड दे के बाद एक सप्ताह के लिए बैठते हैं, कि यह अब थोड़ा अधिक टूटा हुआ है। त्रुटि हैंडलर में, अब मुझे टाइटलर त्रुटि संदेश पॉपिंग, ऊपर मिलता है। अगर मैंने F5 मारा, तो यह रंग कोड के साथ MsgBox निष्पादित और प्रदर्शित करेगा।

तो अब, यह दो बार विफल हो जाएगा, फिर ठीक से 3 ^rd समय निष्पादित करें।

Private Function GetRGB(ByVal ColorCode As Variant) As String 

    Dim R As Long 
    Dim G As Long 
    Dim B As Long 

    If IsNull(ColorCode) Then 
    GetRGB = "0,0,0" 
    Else 
    R = ColorCode Mod 256 
    G = ColorCode \ 256 Mod 256 
    B = ColorCode \ 65536 Mod 256 

    GetRGB = R & "," & G & "," & B 
    End If 

End Function 

मैं क्योंकि जब .Font.Color रंग चयनकर्ता में Automatic के लिए सेट है, मैं एक NULL लौटे मिल एक Variant के रूप में पैरामीटर पारित करने के लिए है If बयान, इस प्रकार:

---

पूर्णता के लिए, यहाँ GetRGB के लिए कोड है GetRGB में।

एक और अपडेट: इस कोड को कुछ और हफ्तों तक बैठने के बाद (यह मेरी जिंदगी को आसान बनाना है, न कि आधिकारिक परियोजना है, इसलिए यह प्राथमिकता सूची के नीचे है), ऐसा लगता है कि यह उत्पन्न करेगा कभी-कभी कभी-कभी, हर कॉल पर त्रुटि।हालांकि, कोड तत्काल विंडो में ठीक से निष्पादित करेगा!

पीले प्रकाश डाला पंक्ति एक त्रुटि जेनरेट है, फिर भी आप तत्काल विंडो में परिणाम देख सकते हैं।

---

इसके अलावा, (मुझे पता है यह वास्तव में एक और सवाल होना चाहिए) अगर किसी को भी जल्दी से SourceSheet.Activate लाइन के लिए किसी भी कारण से देखने के लिए होता है, तो कृपया मुझे बताएं - मैं इसे यादृच्छिक त्रुटियों हो रही थी बिना, तो मैं कर दिया है कि में आमतौर पर ये त्रुटियां वर्तमान सक्रिय शीट पर काम करने वाले अयोग्य संदर्भों के कारण होती हैं (जो RuleSheet जितनी जल्दी हो सकेगी), लेकिन मैंने सोचा कि मेरे सभी संदर्भ योग्य हैं। अगर आपको कुछ याद आती है, तो कृपया पाइप करें! अन्यथा, मैं शायद कोड रीव्यू पर जाउंगा ताकि उन्हें यह ठीक लगे कि मुझे यह ठीक से काम करने के बाद क्या याद आया।

Answer 1

अपने दूसरे प्रश्न के बारे में:
मैं हमेशा है कोशिकाओं है कि एक सक्रिय शीट में नहीं हैं की स्थापना के साथ समस्याओं पड़ा है, SourceSheet.Activate करने में समस्या के लिए सबसे संभावित कारण सेट रेंज बाद में के तथ्य पर निर्भर करता है:

Set FCCell = SourceSheet.Cells(4, SrcCol) 

मैं पाया है कि, अगर चादर सक्रिय नहीं है, यह कोशिकाओं के भीतर() तर्क विफल हो जाएगा, मुझे लगता है कि इस के लिए सबसे अच्छा तरीका कोशिकाओं से पहले रेंज उपयोग कर रहा है।
This may be the case। मुझे लगता है कि मैं एक मूल कारण को यह कम हो गया है

With SourceSheet:Set FCCell = .Range(.Cells(4,SrcCol):End With 

Answer 2

: तो इस उदाहरण के लिए मैं कुछ ऐसा करना होगा। ,

और यहाँ मेरे कोड है एक ही कार्यपुस्तिका में:

मैं मैन्युअल FormatConditions के 2 विभिन्न प्रकार जोड़ा सेल Sheet1.A1 में। ,

Sheet2 FormatCondition 1 
     3243501 
Sheet2 Top10    5 
Sheet1 FormatCondition 1 
     3243501 
Sheet1 Top10    5 
     13998939 

तो FormatConditions.Item विधि हमेशा नहीं लौटेगा एक FormatCondition

मैं अपने तत्काल विंडो व्यवहार को पुनः नहीं कर सकते हैं तो हो सकता है आप अनजाने चादर सक्रिय:

Sub foo() 

    Dim rng As Range 
    Set rng = Sheet1.Range("A1") 

    Dim fc As Object 
    On Error Resume Next 

    Sheet2.Activate 
    Set fc = rng.FormatConditions(1) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 
    Set fc = rng.FormatConditions(2) 
    Dim fnt As Font2 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 

    Sheet1.Activate 
    Set fc = rng.FormatConditions(1) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 
    Set fc = rng.FormatConditions(2) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 

End Sub 

और यहाँ उत्पादन है ?

अगर मैं On Error Resume हटाने, और Top10.Font.Color कॉल के लिए त्रुटि पर तोड़ने, और उसके बाद डीबग विंडो में क्वेरी, मैं मिलता है:

रन-टाइम त्रुटि '-2147417848 (80,010,108)':

स्वचालन त्रुटि ऑब्जेक्ट की गई वस्तु अपने ग्राहकों से डिस्कनेक्ट हो गई है।

जो गूगल Error or Unexpected Behavior with Office Automation When You Use Early Binding in Visual Basic

मेरी परिणाम हासिल करते FormatConditions.Item रिटर्न एक Top10 (अपने UniqueValues प्रकार सहित और शायद अन्य प्रकार के) के आधार पर करने के लिए मुझे लगता है, यह Font.Color संपत्ति का उपयोग करने के लिए संभव नहीं है जब तक रेंज की शीट सक्रिय है।

लेकिन ऐसा लगता है कि आप इसे सक्रिय रखते हैं? मुझे आश्चर्य है कि क्या आप PrintValue में सक्रिय शीट बदल रहे हैं?