Forum - Excel07 Δημιουργία κουμπιού

Σελίδα 2 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Excel07] Δημιουργία κουμπιού (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/4939-dimioyrgia-koympioi.html)

kapetang

11-07-18 11:40

Καλημέρα

Σταμάτη, αντικατέστησε στον κώδικα της φόρμας:

Τη γραμμή κώδικα: If Not Nme.Name Like "*Print_Area*" Then

με την: If Not Nme.Name Like "*!Print_Area*" Then

Και στη διαδικασία CreateLinks:

Τη γραμμή κώδικα: If Not nm.Name Like "*Print_Area*" Then

με την: If Not nm.Name Like "*!Print_Area*" Then

Έτσι πιστεύω θα περιοριστούν και οι εύλογες ανησυχίες του Σπύρου για την «τρύπα» του τελεστή Like.

stam75

12-07-18 11:39

Καλησπέρα! Να με συγχωρείτε για την καθυστέρηση..!
Μόλις ενημέρωσα τις σειρές που μου υπέδειξες Γιώργο!
Σε ευχαριστώ πολύ

kapetang

12-07-18 11:50

Σταμάτη καλημέρα

Στο συνημμένο στο #33 έκανα και κάποιες άλλες αλλαγές στον κώδικα και τη σχεδίαση της φόρμας, ώστε να καλύπτει καλύτερα τις διάφορες περιπτώσεις ονομάτων

stam75

12-07-18 12:58

Αντέγραψα μόνο τον κώδικα του CreateLinks. Θα ενημερώσω και της φόρμας, ευχαριστώ.

stam75

12-07-18 13:19

Γιώργο μου κιτρινίζει αυτό

Κώδικας:

Private Sub Lst_NmRng_Click()

    Application.Goto Range(Me.Lst_NmRng.List), False

End Sub

Ανοίγω τον πίνακα, επιλέγω αριστερά στα φύλλα και μετά όταν κλικάρω δεξιά τις περιοχές μου δίνει error

Spirosgr

12-07-18 13:24

Στην γραμμή, βάλε .Value αντί .List

stam75

12-07-18 13:57

Πολύ σωστά Σπύρο, δικό μου ήταν το λάθος, δεν είχα κάνει εκεί copy paste.
Έχω ολοκληρώσει την ενημέρωση αλλά δε μου εμφανίζει τέρμα δεξιά τις περιοχές όπως στο παράδειγμα του Γιώργου. Τι κάνω λάθος;;

*ΟΚ το βρήκα! τις βλέπω και τις δύο!

stam75

12-07-18 14:25

Εγώ προχθές που σας είπα, ότι το έχετε φθάσει σε άλλο επίπεδο από το αρχικό που ήθελα, δεν είχα άδικο!
Επίσης, όσο και να γουστάρετε να ασχολείστε με τις γραμμές κώδικα, ξέρω σας ότι έχω κουράσει με το συγκεκριμένο ζητούμενο, με συγχωρείτε. :a068:
Θέλω να ρωτήσω εάν υπάρχει η δυνατότητα, όταν κάνω κλικ στις ονομασίες των φύλλων να μη με οδηγεί στο ανάλογο φύλλο, παρά μόνο εάν επιλέξω κάποια περιοχή στη δεξιά στήλη.
Αυτό φυσικά, μόνο εάν δεν χρειαστούν πολλές αλλαγές! Γιατί ρε παιδιά το ξέρω, όσο βελτιώνετε εσείς, τόσο θα βρίσκεται κάτι.
Είστε κορυφή!

Spirosgr

12-07-18 14:35

Επειδή έχουμε φτάσει τα 50 posts και μάλλον επαναλαμβανόμαστε τώρα,
μια τελευταία...πολύ πρόχειρα.

Πάρε την γραμμή (cut)
Worksheets(Me.Lst_Sh.Value).Activate
από την
Private Sub Lst_Sh_Click()

και βάλτην (paste) πρώτη στην
Private Sub Lst_NmRng_Click()

kapetang

12-07-18 14:42

1 Συνημμένο(α)

Καλησπέρα

Φίλε Σταμάτη δες το συνημμένο

stam75

12-07-18 14:47

Πολύ ωραία σας ευχαριστώ για μια ακόμη φορά παιδιά!

kapetang

12-07-18 16:08

Σταμάτη να είσαι καλά και ελπίζω τώρα να τελειώσαμε....

Στο προηγούμενο μήνυμά μου κατά λάθος επισύναψα μια παλιότερη έκδοση του αρχείου.

Την αντικατέστησα.

Spirosgr

12-07-18 17:16

Και στο post 41, να αλλάξεις στην γραμμή:
If Not Nme.Name Like "!*Print_Area*" Then
την ακολουθία !* σε *! ...

stam75

12-07-18 18:00

Έγινε παιδιά θα τα τσεκάρω αυτά που είπατε!
Η αλήθεια είναι πως ναι πρέπει να σταματήσουμε. Ολοκληρώθηκε αυτό που ζητούσα, έγιναν βελτιώσεις, διορθώσεις, γενικά πιστεύω πως το επίπεδο είναι πολύ παραπάνω από αυτο που ζητούσα και ανταποκριθήκατε άμεσα σε κάθε βήμα για την λύση του. Να είστε καλά, σας υπέρ ευχαριστώ!

stam75

12-07-18 21:39

2 Συνημμένο(α)

Καλησπέρα!
Έχω κάνει μερικές μικροαλλαγές στην εμφάνιση και κάποιες προσθήκες και είπα να σας δείξω όπως είναι τώρα
Φαντάζομαι πως όταν τελειώσει όλο το στήσιμο θα ανέβει γιατί ενδιαφέρει κάποια άτομα. Όπως επίσης μπορεί κάποιος που θα το δουλέψει να το βελτιώσει!

stam75

14-07-18 18:21

Καλησπέρα σας παιδιά. Πιστεύω να είστε καλά.
Συνάντησα ένα θεματάκι με τον πίνακα στον υπολογιστή που πήγα να το δουλέψω.
στο κομμάτι παρακάτω.
Όταν άνοιξα τον πίνακα, με το που έκανα κλικ στα φύλλα, πέταξε 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.
Θα γίνει καλά γιατρέ μου;;;

kapetang

14-07-18 19:57

1 Συνημμένο(α)

Καλησπέρα

Σταμάτη, ο κώδικας που επισυνάπτεις, στον υπολογιστή μου, λειτουργεί κανονικά.

Θα πρότεινα να ελέγξεις τις αναφορές.

Θα πρέπει να τσεκάρεις όσες φαίνονται στο συνημμένο και να ξετσεκάρεις όσες είναι MISSING.

Δοκίμασε και τον κώδικα (έκανα κάποιες αλλαγές) :

Κώδικας:

Option Explicit

Dim shSel As Worksheet
 

Private Sub Lst_NmRng_Click()

    shSel.Activate

    Application.Goto Range(Me.Lst_NmRng.Value), False

End Sub
 

Private Sub Lst_Sh_Click()

    Dim Nme As Name, rngTest As Range, LO As ListObject, i As Long, x() As String

    

    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
 

    For Each LO In shSel.ListObjects

        x(0, i) = LO.Name: x(1, i) = Replace(LO.Range.Address, "$", "")

        i = i + 1

    Next

    If i = 0 Then

        shSel.Activate

    Else

        ReDim Preserve x(1, i) As String

        Me.Lst_NmRng.Column = x

    End If

    

End Sub
 

Private Sub UserForm_Initialize()

    Dim Wsh As Worksheet

    For Each Wsh In ThisWorkbook.Sheets

        Me.Lst_Sh.AddItem Wsh.Name

    Next Wsh

End Sub

Καλή τύχη ...............

stam75

14-07-18 20:36

Γιώργο μόλις έκανα τις αλλαγές. Σε ευχαριστώ πολύ για μια ακόμη φορά.

stam75

17-07-18 08:51

Καλημέρα σας!
Γιώργο οι αλλαγές που έκανες τελευταία στον κώδικα λειτουργούν άψογα. Πλέον λειτουργεί και στον άλλον υπολογιστή. Σε ευχαριστώ πολύ!

kapetang

17-07-18 09:54

Να είσαι καλά Σταμάτη και καλή συνέχεια.

stam75

07-08-18 20:44

Καλησπέρα σας! Πιστεύω να είστε καλά!
Επανέρχομαι στο συγκεκριμένο θέμα λόγω του ότι αντιμετώπισα ένα θεματάκι.
Δεν έχω πειράξει τίποτα στον κώδικα, καμία αλλαγή.
Έχω προσθέσει προστασία με κωδικό σε κάποια φύλλα, με αποτέλεσμα όταν λειτουργώ την userform να μου εμφανίζει ένα παράθυρο και να μου κιτρινίζει την σειρά με τα κόκκινα γράμματα.
(ενώ στου Γιώργου το φύλλο δεν συναντώ αυτό το πρόβλημα)
Όταν την βγάζω δουλεύει κανονικά.

Κώδικας:

Private Sub Lst_NmRng_Click()

    shSel.Activate

        Application.GoTo Range(Me.Lst_NmRng.Value), False

End Sub

Μπορώ με κάποιον τρόπο να έχω και προστασία στα φύλλα αλλά και να μη μου εμφανίζει το παράθυρο με το σφάλμα;

Σας ευχαριστώ πολύ!

Edit

το κατάφερα με το παρακάτω

Κώδικας:

Private Sub Lst_NmRng_Click()

Application.ScreenUpdating = False

Sheets("ΑΡΧΙΚΟ").Unprotect Password:="Password"

Sheets("ΤΕΛΙΚΟ").Unprotect Password:="Password"

    shSel.Activate

        Application.GoTo Range(Me.Lst_NmRng.Value), False

Sheets("ΑΡΧΙΚΟ").Protect Password:="Password"

Sheets("ΤΕΛΙΚΟ").Protect Password:="Password"

        Application.ScreenUpdating = True

End Sub

Το πάω καλά για όσα φύλλα έχουν προστασία;

Η ώρα είναι 17:15.

Σελίδα 2 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Search Engine Optimization by vBSEO 3.3.2