Private Sub Workbook_Open()
Macro1
End SubSub Macro1()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile ThisWorkbook.Path & "\dsofile.dll"
End SubOption Explicit
Sub taoFileDoc()
Dim i As Long
Dim FolderName As String, TenFile As String, sTitle As String, sSubject As String, sAuthor As String
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
FolderName = Cells(4, 5)
TenFile = InputBox("Nhap ten File")
sTitle = InputBox("Nhap Title")
sSubject = InputBox("Nhap Subject")
sAuthor = InputBox("Nhap Author")
With wordAppl
.Documents.Add
.ActiveDocument.BuiltinDocumentProperties(1) = sTitle
.ActiveDocument.BuiltinDocumentProperties(2) = sSubject
.ActiveDocument.BuiltinDocumentProperties(3) = sAuthor
.ActiveDocument.SaveAs FolderName & TenFile & ".doc"
.Visible = True
End With
Application.ScreenUpdating = True
Set wordAppl = Nothing
End SubSub loc_thang()
[B]ActiveSheet.Unprotect "123"[/B]
Application.ScreenUpdating = False
thg = InputBox("Nhap thang can loc", "QUAN LY HO SO VAN BAN")
lrow = Cells(5, 5)
For I = 9 To lrow
Cells(I, 9) = Month(Cells(I, 2))
Next
Set rngFind = Range("I9:I" & lrow).Find(thg)
If rngFind Is Nothing Then
MsgBox "Khong co dulieu can loc", , "Thong Bao"
Exit Sub
End If
show_All
Range("A8").AutoFilter Field:=9, Criteria1:=thg
Range("I9:I" & lrow).ClearContents
Application.ScreenUpdating = True
[B]ActiveSheet.Protect "123"[/B]
End SubSub Print_Show()
Application.Dialogs(8).Show
End SubSub DongFile()
ActiveWorkbook.Save
Application.Quit
End SubPrivate Sub CommandButton1_Click()
On Error GoTo Boqua
Dim i As Long
Dim FolderName As String, TenFile As String, sTitle As String, sSubject As String, sAuthor As String
[B]Dim sCategory As String, sManager As String[/B]
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
FolderName = Cells(4, 5)
TenFile = TextBox1.Text
sTitle = TextBox2.Text
sSubject = TextBox3.Text
sAuthor = TextBox4.Text
[B]sCategory = TextBox5.Text[/B]
[B]sManager = TextBox6.Text[/B]
With wordAppl
.Documents.Add
.ActiveDocument.BuiltinDocumentProperties(1) = sTitle
.ActiveDocument.BuiltinDocumentProperties(2) = sSubject
.ActiveDocument.BuiltinDocumentProperties(3) = sAuthor
[B].ActiveDocument.BuiltinDocumentProperties(18) = sCategory[/B]
[B].ActiveDocument.BuiltinDocumentProperties(20) = sManager[/B]
.ActiveDocument.SaveAs FolderName & "\" & TenFile & ".doc"
.Visible = True
End With
Application.ScreenUpdating = True
Boqua:
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
Set wordAppl = Nothing
UserForm1.Hide
End SubIf IsNumeric(TextBox6.Text) = True Or IsDate(TextBox6.Text) = False Then
MsgBox "Ban phai nhap Manager dang date (dd/mm/yy)", , "Thong Bao"
TextBox6.Text = ""
Exit Sub
End If
TextBox6.Text = DateSerial(Mid(TextBox6.Text, 7, 2), Mid(TextBox6.Text, 4, 2), Mid(TextBox6.Text, 1, 2))
TextBox6.Text = Format(TextBox6.Text, "dd/mm/yy")Bạn dùng code sau, chú ý một số điểm:
Private Sub CommandButton1_Click()
With UserForm1
.TextBox1.Text = ""
.TextBox2.Text = ""
.TextBox3.Text = ""
.TextBox4.Text = ""
.TextBox5.Text = ""
.TextBox6.Text = ""
.TextBox7.Text = ""
.CommandButton2.Enabled = False
End With
UserForm1.Show
End SubPrivate oFilePropReader As DSOleFile.PropertyReader
Private oDocProp As DSOleFile.DocumentProperties
Dim eFile As String, eFolderName As String
Private Sub CommandButton1_Click()
On Error Resume Next
Dim stt As Integer
Dim ewbName As String
Dim oCustProp As DSOleFile.CustomProperty
Set oFilePropReader = New DSOleFile.PropertyReader
eFolderName = Cells(4, 5)
stt = TextBox1.Text
ewbName = Cells(stt + 8, 3)
eFile = eFolderName & "\" & ewbName
Set oDocProp = oFilePropReader.GetDocumentProperties(eFile)
TextBox2.Text = oDocProp.Name
TextBox3.Text = oDocProp.Title
TextBox4.Text = oDocProp.Subject
TextBox5.Text = oDocProp.Author
TextBox6.Text = oDocProp.Category
TextBox7.Text = oDocProp.Manager
CommandButton2.Enabled = True
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Dim oCustProp As DSOleFile.CustomProperty
Name eFile As eFolderName & "\" & TextBox2.Text
oDocProp.Title = TextBox3.Text
oDocProp.Subject = TextBox4.Text
oDocProp.Author = TextBox5.Text
oDocProp.Category = TextBox6.Text
oDocProp.Manager = TextBox7.Text
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
Set oDocProp = Nothing
End Sub
Private Sub CommandButton3_Click()
UserForm1.Hide
End Sub
