các bạn cho mình hỏi ? mình có tạo 1file excel với các định dạng có sẵn với các công thức lập sẵn,mà trong quá trình sử dụng mình ko muốn làm việc trên file này sau đó làm cho công việc khác lại phải copy và save as,đổi tên.có cách nào để tạo 1file gốc với caccống thức định dạng lập sẵn,khi chạy file này sẽ có chức năng save thành 1file mới mang thuộc tính của file gốc không?
vídụ: bạn có 1forder VD và 1file VD.xls được gọi là file gốc, khi chạy file này sẽ xuất hiện bảng thông báo "bạn hãy nhập tên file cần tao", nếu trong forder VD có file trùng tên sẽ xuất hiện bảng thông báo "bạn hãy nhập tên khác"
xin các bạn chỉ giúp xin cảm ơn nhiều.
+ sau đây là code 1 chương trình có chức năng như vậy:
ub qt_open()
Dim makt1 As String, makt2 As String, s1 As String, s2 As String, v As String
Range("a1").Select
fch1 = ActiveCell.Offset(299, 1)
fch2 = ActiveCell.Offset(299, 2)
lic1 = ActiveCell.Offset(300, 1)
lic2 = ActiveCell.Offset(300, 2)
If Len(Dir(fch1)) > 1 Then
Open fch1 For Input As #1
Do While Not EOF(1)
makt = makt & Input(1, #1)
Loop
Close
If makt = lic1 Then
ActiveWindow.Close savechanges:=False
Let Application.Caption = "Phan he lap quyet toan XLCT 2007"
Set myMenuBar = CommandBars.ActiveMenuBar
Set XDCTMenu = myMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
XDCTMenu.Caption = "Xay lap 2007"
Set ctrl1 = XDCTMenu.CommandBar.Controls.Add(Type:=msoControlButton)
Set ctrl2 = XDCTMenu.CommandBar.Controls.Add(Type:=msoControlButton)
With ctrl1
.Caption = "Chiet tinh quyet toan"
.OnAction = "QT_run"
End With
With ctrl2
.Caption = "Chen dong - Xoa dong"
.OnAction = "indelrow"
End With
ofile = InputBox("Xin chao! Ban hay nhap ten tap tin can tao:", "XDCT 2007")
ofile = "d:\ct2007\quyettoan\" & ofile & ".xls"
If Len(Dir(ofile)) > 1 Then
ofile = InputBox("Tap tin <" & ofile & "> da co trong he thong. Ban hay nhap mot ten khac", "XDCT 2007")
ofile = "d:\ct2007\quyettoan\" & ofile & ".xls"
End If
FileCopy "d:\ct2007\mau_qtoan.xls", ofile
If Len(Dir("d:\ct2007\dm2007.xls")) > 1 Then
End If
Workbooks.Open Filename:=ofile
curfile = Right(ofile, Len(ofile) - 20)
Windows(curfile).Visible = True
MsgBox "He thong da san sang.", , "XDCT 2007"
Else
Application.DisplayAlerts = False
Application.Quit
End If
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
vídụ: bạn có 1forder VD và 1file VD.xls được gọi là file gốc, khi chạy file này sẽ xuất hiện bảng thông báo "bạn hãy nhập tên file cần tao", nếu trong forder VD có file trùng tên sẽ xuất hiện bảng thông báo "bạn hãy nhập tên khác"
xin các bạn chỉ giúp xin cảm ơn nhiều.
+ sau đây là code 1 chương trình có chức năng như vậy:
ub qt_open()
Dim makt1 As String, makt2 As String, s1 As String, s2 As String, v As String
Range("a1").Select
fch1 = ActiveCell.Offset(299, 1)
fch2 = ActiveCell.Offset(299, 2)
lic1 = ActiveCell.Offset(300, 1)
lic2 = ActiveCell.Offset(300, 2)
If Len(Dir(fch1)) > 1 Then
Open fch1 For Input As #1
Do While Not EOF(1)
makt = makt & Input(1, #1)
Loop
Close
If makt = lic1 Then
ActiveWindow.Close savechanges:=False
Let Application.Caption = "Phan he lap quyet toan XLCT 2007"
Set myMenuBar = CommandBars.ActiveMenuBar
Set XDCTMenu = myMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
XDCTMenu.Caption = "Xay lap 2007"
Set ctrl1 = XDCTMenu.CommandBar.Controls.Add(Type:=msoControlButton)
Set ctrl2 = XDCTMenu.CommandBar.Controls.Add(Type:=msoControlButton)
With ctrl1
.Caption = "Chiet tinh quyet toan"
.OnAction = "QT_run"
End With
With ctrl2
.Caption = "Chen dong - Xoa dong"
.OnAction = "indelrow"
End With
ofile = InputBox("Xin chao! Ban hay nhap ten tap tin can tao:", "XDCT 2007")
ofile = "d:\ct2007\quyettoan\" & ofile & ".xls"
If Len(Dir(ofile)) > 1 Then
ofile = InputBox("Tap tin <" & ofile & "> da co trong he thong. Ban hay nhap mot ten khac", "XDCT 2007")
ofile = "d:\ct2007\quyettoan\" & ofile & ".xls"
End If
FileCopy "d:\ct2007\mau_qtoan.xls", ofile
If Len(Dir("d:\ct2007\dm2007.xls")) > 1 Then
End If
Workbooks.Open Filename:=ofile
curfile = Right(ofile, Len(ofile) - 20)
Windows(curfile).Visible = True
MsgBox "He thong da san sang.", , "XDCT 2007"
Else
Application.DisplayAlerts = False
Application.Quit
End If
Else
Application.DisplayAlerts = False
Application.Quit
End If
End Sub