- Katılım
- 25 Ekim 2011
- Mesajlar
- 43
- Excel Vers. ve Dili
- Evde 2007 Türkçe
İşte 2007 İngilizce
Üstadlar merhabalar,
Oluşturduğum bir dosya var. Aşağıdaki makro ile belirli bir hücreden kaydedileceği klasörü seçmesini istiyorum. Klasörü sabit verince sorun yok. dosya ismi oluşturuyor. Ancak klasör ismini değişkene bağladığımda sorun oluyor. Artık kod körlüğü başladı göremiyorum hatayı, bir göz atıp akıl veren olursa çok makbule geçer.
Ufuk Alpat
Oluşturduğum bir dosya var. Aşağıdaki makro ile belirli bir hücreden kaydedileceği klasörü seçmesini istiyorum. Klasörü sabit verince sorun yok. dosya ismi oluşturuyor. Ancak klasör ismini değişkene bağladığımda sorun oluyor. Artık kod körlüğü başladı göremiyorum hatayı, bir göz atıp akıl veren olursa çok makbule geçer.
Ufuk Alpat
Kod:
Private Sub CommandButton2_Click()
Dim U As String
Dim C As String
Dim S1 As String
Dim N As String
Dim WB As String
WB = ThisWorkbook.Name
U = Range("X1").Value
C = Range("K1").Value
S1 = "silinecek"
Application.ScreenUpdating = False
On Error Resume Next
Kill "N:\SAP_PROJE\QM\DATA\GENEL\silinecek.xlsx"
ActiveSheet.Unprotect "AKGS"
Range("B2:J51").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R2:AE51") = ""
Columns("A:J").EntireColumn.Hidden = False
Columns("C:H").EntireColumn.Hidden = True
Range("C2:J51").Locked = True
Range("K1").Locked = True
Range("X1").Locked = True
Worksheets("Kayıt").Visible = True
Sheets("Kayıt").Copy
ActiveWorkbook.SaveAs Filename:= _
"N:\SAP_PROJE\QM\DATA\GENEL\" & S1 & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks(WB).Activate
Sheets("SONUC_GIRISI").Select
Range("A1:J51").Select
Selection.Copy
Workbooks("silinecek").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("silinecek").Activate
Columns("C:H").Delete Shift:=xlToLeft
Columns("A:D").EntireColumn.AutoFit
N = Range("D2").Value
ActiveWorkbook.Sheets("Kayıt").Protect "AKGS", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = False
ActiveWorkbook.SaveAs Filename:= _
"N:\SAP_PROJE\QM\DATA\" & N & " \ " & U & "_" & C & "_" & Format(Now(), "mm_dd_yyyy hh mm ss AMPM") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.ScreenUpdating = True
MsgBox "Sonuç Kayıt İşleminiz Tamamlanmıştır, Teşekkürler...", vbInformation, "SAP QM Anahtar Kullanıcı Ufuk Alpat ® ™"
Application.DisplayAlerts = False
Application.Quit
End Sub
