Εμφάνιση ενός μόνο μηνύματος
  #14  
Παλιά 24-07-14, 21:59
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Ή καλύτερα με τον παρακάτω:

Κώδικας:
Sub ReplaceMultiRecursive()
'Η ρουτίνα χρησιμοπιοεί την αναδρομική συνάρτηση ReplaceMultiRecursion
'Μπορεί να διαμορφωθεί ώστε να καλεί τη συνάρτηση μόνο για τα κελιά
'στα οποία θέλουμε να γίνουν αλλαγές
'-----------------------------------------------------------------------------------
    Dim c As Range
    Dim rngSource As Range

    On Error GoTo Error_Handel

    Set rngSource = Application.InputBox("Επιλογή περιοχής που θα μετατραπεί", , , , , , , 8)

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .ShowWindowsInTaskbar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    For Each c In rngSource
        If c.Locked = False And _
           InStr(c.Formula, "-") = 0 And _
           InStr(c.Formula, "/") = 0 And _
           c.HasFormula Then
            'Η Public μεταβλητή έχει δηλωθεί στο Module2. Εδώ αρχικοποιείται
            strF = c.Formula
            c.Formula = ReplaceMultiRecursion(c.Formula)
        End If
    Next
    MsgBox "Ολοκληρώθηκε!"
Sub_Exit:

    With Application
        .Calculation = xlCalculationAutomatic
        .ShowWindowsInTaskbar = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub

Error_Handel:
    MsgBox "Πιθανόν δεν δόθηκε σωστά η περιοχή δεδομένων", vbCritical + vbOKOnly, "Λάθος!"
    Resume Sub_Exit
End Sub
Απάντηση με παράθεση