Εμφάνιση ενός μόνο μηνύματος
  #56  
Παλιά 14-07-18, 18:21
stam75 Ο χρήστης stam75 δεν είναι συνδεδεμένος
Όνομα: Σταμάτης
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 26-09-2015
Μηνύματα: 107
Προεπιλογή

Καλησπέρα σας παιδιά. Πιστεύω να είστε καλά.
Συνάντησα ένα θεματάκι με τον πίνακα στον υπολογιστή που πήγα να το δουλέψω.
στο κομμάτι παρακάτω.
Όταν άνοιξα τον πίνακα, με το που έκανα κλικ στα φύλλα, πέταξε error, έκανα debug, κιτρίνισε η σειρά που έχω με Magenta και μπλε η σειρά που έχω το κόκκινο.

Κώδικας:
Private Sub Lst_Sh_Click()
    Dim Nme As Name, rngTest As Range, LO As ListObject, sh As Worksheet, i As Long
    Me.Lst_NmRng.Clear
    Set shSel = Worksheets(Me.Lst_Sh.Value)
    ReDim x(1, 1000) As String
    On Error Resume Next
    For Each Nme In ThisWorkbook.Names
        Set rngTest = Range(Nme.Name)
        If Err = 0 Then
            If Not Nme.Name Like "*!Print_Area*" Then
                If Nme.RefersTo Like "*" & Me.Lst_Sh.Value & "*" Then
                    x(0, i) = Nme.Name:
                    x(1, i) = Replace(Replace(Replace(Replace(Nme.RefersTo, "$", ""), "'", ""), Me.Lst_Sh.Value & "!", ""), "=", "")
                    i = i + 1
                End If
            End If
        Else
            Err.Clear
        End If
    Next Nme
    On Error GoTo 0
    Set sh = Worksheets(Me.Lst_Sh.Value)
    For Each LO In sh.ListObjects
        x(0, i) = LO.Name: x(1, i) = Replace(LO.Range.Address, "$", "")
        Me.Lst_NmRng.AddItem LO.Name
        i = i + 1
    Next
    ReDim Preserve x(1, i) As String
    Me.Lst_NmRng.Column = x
    If i = 0 Then shSel.Activate
End Sub
Σε ίδιο λειτουργικό, ίδια office.
Θα γίνει καλά γιατρέ μου;;;
Απάντηση με παράθεση