Εμφάνιση ενός μόνο μηνύματος
  #1  
Παλιά 16-05-13, 21:15
othonas Ο χρήστης othonas δεν είναι συνδεδεμένος
Όνομα: ΟΘΩΝΑΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 10-05-2013
Μηνύματα: 27
Προεπιλογή Δημιουργία Φύλλου Εργασίας με κώδικα

Καλησπέρα σε όλους!!! Σε προηγούμενο θέμα (Δημιουργία Μορφοποιημένου Φύλλου Εργασίας με κώδικα) .Έχετε δημιουργήσει module για Δημιουργία Μορφοποιημένου Φύλλου Εργασίας με κώδικα ως συνημμένο . Θα ήθελα να ρωτήσω αν γίνεται να μην κάνει αντικατάσταση του υπάρχοντος φύλλου αλλά να μας ειδοποιεί ότι το φύλλο που πάμε να δημιουργήσουμε υπάρχει ήδη και να έχει σαν αποτέλεσμα την μη δημιουργία ή αντικατασταση.Παραθέτω το module παρακάτω .
[code]
Option Explicit
Const ilegalChars = ":\/?*[]"

Sub NewOffer()
Dim rng As Range, Wks As Worksheet, NewWks As Worksheet, _
xPos As Integer, OfferName As String, SheetName As String
Application.ScreenUpdating = False
OfferName = VBA.InputBox("Δώσε Eπωνυμία", "Νέα προσφορά...")
If StrPtr(OfferName) = 0 Then Exit Sub
SheetName = CleanName(OfferName)
xPos = NewSheetPosition(NewName:=SheetName)
Set Wks = ActiveSheet
Wks.Range("A:E").AutoFilter Field:=3, Criteria1:=">0", _
Operator:=xlAnd

With ThisWorkbook.Worksheets("OfferTemplate")
.Visible = xlSheetVisible
.Copy After:=Sheets(xPos)
.Visible = xlSheetHidden
End With
Set NewWks = ActiveSheet
Set rng = Wks.AutoFilter.Range.Offset(1)
rng.Copy
With NewWks
.Name = SheetName
.Range("B1") = OfferName
.Range("A5").PasteSpecial xlPasteValues
.Range("A5").Select
End With
Wks.AutoFilterMode = False
Application.CutCopyMode = False

End Sub

Function NewSheetPosition(NewName As String) As Integer
Dim sh As Object, i As Integer
For Each sh In ThisWorkbook.Sheets
If sh.Name = NewName Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Else
If sh.Visible Then i = i + 1
End If
Next
NewSheetPosition = i
End Function

Function CleanName(strName As String) As String
Dim i As Integer, tmpName As String
tmpName = strName
For i = 1 To Len(ilegalChars)
tmpName = Replace(tmpName, Mid(ilegalChars, i, 1), "_")
Next
CleanName = tmpName
End Function
[\code]
Ευχαριστώ όλους όσους απαντήσουν
Απάντηση με παράθεση