[Giúp] Sửa code định dạng chữ ký ẩn dưới số trang trong word từ Excel

jeck09nt

Thành viên mới
Tham gia ngày
29 Tháng mười 2006
Bài viết
6
Được thích
3
Điểm
665
Kính gưi các Anh/Chị,
Mình có sưu tầm đoạn code insert chữ ký thực hiện từ Excel vào word như sau :

Mã:
Sub PlaceTextInFooter_Test()
Const wdAlignPageNumberCenter = 1
Dim oWord As Object 'Word.Application
Dim myDoc As Object 'Document
Dim folder As Object


Set oWord = GetObject("", "Word.Application")
Set myDoc = oWord.Documents.Open("D:\PDF\Test1.docx")
     Dim Duongdanchuky As String
        Duongdanchuky = "D:\PDF\chuky.png"
        myDoc.Sections(1).Footers(1).PageNumbers.Add (wdAlignPageNumberCenter)
        myDoc.Sections(1).Footers(1).Range.InlineShapes.AddPicture Filename:=Duongdanchuky, linktofile:=False, savewithdocument:=True
        myDoc.Save
myDoc.Close
Set oWord = Nothing
Set myDoc = Nothing
End Sub
đối với code này mình đã thực hiện được theo mẫu Test1.doxc
Giờ mình muốn chỉnh code trên để làm sao sau khi thực hiện lệnh thì chữ ký sẽ được định dạng ẩn dưới số trang và canh giữa như file Test2.docx

Trân trọng cám ơn các Anh/Chị đã quan tâm !!!
 

File đính kèm

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,678
Được thích
5,678
Điểm
560
Thử xem nhé
Mã:
Sub PlaceTextInFooter_Test()
Const wdPaneNone = 0
Const wdPrintView = 3

Dim oWord As Object 'Word.Application
Dim myDoc As Object 'Document
Dim Duongdanchuky As String

    Set oWord = GetObject("", "Word.Application")
    Set myDoc = oWord.Documents.Open("D:\PDF\Test1.docx")
    Duongdanchuky = "D:\PDF\chuky.png"
    myDoc.Sections(1).Footers(1).Range.Select
    oWord.Selection.TypeText vbTab
    oWord.Selection.InlineShapes.AddPicture Filename:=Duongdanchuky, linktofile:=False, savewithdocument:=True
    With oWord.ActiveWindow
        .ActivePane.Close
        If .View.SplitSpecial = wdPaneNone Then
            .ActivePane.View.Type = wdPrintView
        Else
            .View.Type = wdPrintView
        End If
    End With
    myDoc.Close True
    Set myDoc = Nothing
    Set oWord = Nothing
End Sub
 

jeck09nt

Thành viên mới
Tham gia ngày
29 Tháng mười 2006
Bài viết
6
Được thích
3
Điểm
665
Gửi Batman1,
Mình cám ơn bạn đã giúp, nhưng code mình thực hiện thì đã canh giữa và bị mất số trang.
Mình nhờ Batman1 xem hộ lại giúp nhé.
Đính kèm là 2 ảnh mình đã format tay trong word.
Xin cám ơn.
T.T
 

File đính kèm

AnhThu-1976

Thành viên tích cực
Tham gia ngày
17 Tháng mười 2014
Bài viết
807
Được thích
128
Điểm
420
Thử xem nhé
Mã:
Sub PlaceTextInFooter_Test()
Const wdPaneNone = 0
Const wdPrintView = 3

Dim oWord As Object 'Word.Application
Dim myDoc As Object 'Document
Dim Duongdanchuky As String

    Set oWord = GetObject("", "Word.Application")
    Set myDoc = oWord.Documents.Open("D:\PDF\Test1.docx")
    Duongdanchuky = "D:\PDF\chuky.png"
    myDoc.Sections(1).Footers(1).Range.Select
    oWord.Selection.TypeText vbTab
    oWord.Selection.InlineShapes.AddPicture Filename:=Duongdanchuky, linktofile:=False, savewithdocument:=True
    With oWord.ActiveWindow
        .ActivePane.Close
        If .View.SplitSpecial = wdPaneNone Then
            .ActivePane.View.Type = wdPrintView
        Else
            .View.Type = wdPrintView
        End If
    End With
    myDoc.Close True
    Set myDoc = Nothing
    Set oWord = Nothing
End Sub
Anh cho em hỏi, có thể áp dụng cho các file excel không?
Nếu được thì ví dụ File Tên xyz trong file có 3 sheet, mỗi sheet có từ 1 đến 3 trang
Em cảm ơn anh!
 

AnhThu-1976

Thành viên tích cực
Tham gia ngày
17 Tháng mười 2014
Bài viết
807
Được thích
128
Điểm
420
Kính gưi các Anh/Chị,
Mình có sưu tầm đoạn code insert chữ ký thực hiện từ Excel vào word như sau :

Mã:
Sub PlaceTextInFooter_Test()
Const wdAlignPageNumberCenter = 1
Dim oWord As Object 'Word.Application
Dim myDoc As Object 'Document
Dim folder As Object


Set oWord = GetObject("", "Word.Application")
Set myDoc = oWord.Documents.Open("D:\PDF\Test1.docx")
     Dim Duongdanchuky As String
        Duongdanchuky = "D:\PDF\chuky.png"
        myDoc.Sections(1).Footers(1).PageNumbers.Add (wdAlignPageNumberCenter)
        myDoc.Sections(1).Footers(1).Range.InlineShapes.AddPicture Filename:=Duongdanchuky, linktofile:=False, savewithdocument:=True
        myDoc.Save
myDoc.Close
Set oWord = Nothing
Set myDoc = Nothing
End Sub
đối với code này mình đã thực hiện được theo mẫu Test1.doxc
Giờ mình muốn chỉnh code trên để làm sao sau khi thực hiện lệnh thì chữ ký sẽ được định dạng ẩn dưới số trang và canh giữa như file Test2.docx

Trân trọng cám ơn các Anh/Chị đã quan tâm !!!
Bạn cho hỏi cách
Làm sao chữ ký nó được nằm giữa và trong khung Footer
Bạn phải định dạng File Nào: Test1.docx hay chuky.png và cách định dạng như thế nào? Bạn hướng dẫn mình được không?
Cảm ơn bạn trước nhé!
 

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,678
Được thích
5,678
Điểm
560
Gửi Batman1,
Mình cám ơn bạn đã giúp, nhưng code mình thực hiện thì đã canh giữa và bị mất số trang.
Mình nhờ Batman1 xem hộ lại giúp nhé.
Đính kèm là 2 ảnh mình đã format tay trong word.
Xin cám ơn.
T.T
À, bây giờ tôi mới nhìn kỹ. Tôi tưởng bỏ số trang đi. Nhưng sao lại muốn số trang và ảnh cùng chỗ nhỉ. Thôi bạn đợi người khác nhé.
 

tigertiger

Coming back ...
Tham gia ngày
25 Tháng một 2007
Bài viết
1,716
Được thích
1,608
Điểm
860
Kính gưi các Anh/Chị,
Mình có sưu tầm đoạn code insert chữ ký thực hiện từ Excel vào word như sau :

Mã:
Sub PlaceTextInFooter_Test()
Const wdAlignPageNumberCenter = 1
Dim oWord As Object 'Word.Application
Dim myDoc As Object 'Document
Dim folder As Object


Set oWord = GetObject("", "Word.Application")
Set myDoc = oWord.Documents.Open("D:\PDF\Test1.docx")
     Dim Duongdanchuky As String
        Duongdanchuky = "D:\PDF\chuky.png"
        myDoc.Sections(1).Footers(1).PageNumbers.Add (wdAlignPageNumberCenter)
        myDoc.Sections(1).Footers(1).Range.InlineShapes.AddPicture Filename:=Duongdanchuky, linktofile:=False, savewithdocument:=True
        myDoc.Save
myDoc.Close
Set oWord = Nothing
Set myDoc = Nothing
End Sub
đối với code này mình đã thực hiện được theo mẫu Test1.doxc
Giờ mình muốn chỉnh code trên để làm sao sau khi thực hiện lệnh thì chữ ký sẽ được định dạng ẩn dưới số trang và canh giữa như file Test2.docx

Trân trọng cám ơn các Anh/Chị đã quan tâm !!!
Bạn thử ghi macro là có thể có cách
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,965
Được thích
9,308
Điểm
860
Nơi ở
TP.HCM
Giờ mình muốn chỉnh code trên để làm sao sau khi thực hiện lệnh thì chữ ký sẽ được định dạng ẩn dưới số trang và canh giữa như file Test2.docx
Bạn thử code này
Mã:
Sub PlaceTextInFooter_Test()
    Const Duongdanchuky = "D:\PDF\chuky.png"
    Dim Pic As Shape
    With Application.Documents.Open("D:\PDF\Test1.docx")
        With .Sections(1).Footers(1)
            Set Pic = .Shapes.AddPicture(FileName:=Duongdanchuky, LinkToFile:=False, SaveWithDocument:=True)
            Pic.WrapFormat.Type = wdWrapBehind
            .Shapes.Range(Pic.Name).Align msoAlignCenters, True
            .PageNumbers.Add (wdAlignPageNumberCenter)
        End With
        .Save:  .Close
    End With
End Sub
 

jeck09nt

Thành viên mới
Tham gia ngày
29 Tháng mười 2006
Bài viết
6
Được thích
3
Điểm
665
Gửi huuthang_bd,
Mình đã test code thì bị thông báo lỗi như 2 hình đính kèm.
Nhờ bạn xem lại giúp nhé !
Xin cám ơn !
T.T
Bài đã được tự động gộp:

Bạn cho hỏi cách
Làm sao chữ ký nó được nằm giữa và trong khung Footer
Bạn phải định dạng File Nào: Test1.docx hay chuky.png và cách định dạng như thế nào? Bạn hướng dẫn mình được không?
Cảm ơn bạn trước nhé!
Mình có gửi 2 ảnh định dạng tay trên word đó bạn !
File mình nhờ hỗ trợ là
Test2.docx
T.T
 

File đính kèm

jeck09nt

Thành viên mới
Tham gia ngày
29 Tháng mười 2006
Bài viết
6
Được thích
3
Điểm
665
Bạn thử code này
Mã:
Sub PlaceTextInFooter_Test()
    Const Duongdanchuky = "D:\PDF\chuky.png"
    Dim Pic As Shape
    With Application.Documents.Open("D:\PDF\Test1.docx")
        With .Sections(1).Footers(1)
            Set Pic = .Shapes.AddPicture(FileName:=Duongdanchuky, LinkToFile:=False, SaveWithDocument:=True)
            Pic.WrapFormat.Type = wdWrapBehind
            .Shapes.Range(Pic.Name).Align msoAlignCenters, True
            .PageNumbers.Add (wdAlignPageNumberCenter)
        End With
        .Save:  .Close
    End With
End Sub
Gửi
huuthang_bd,
Giúp mình với nhé
 

huuthang_bd

Chuyên gia GPE
Tham gia ngày
10 Tháng chín 2008
Bài viết
7,965
Được thích
9,308
Điểm
860
Nơi ở
TP.HCM
Gửi

huuthang_bd,
Giúp mình với nhé
Tôi đọc lại thì thấy bạn dùng code trên Excel. Bạn dùng code này thử.
Mã:
Sub PlaceTextInFooter_Test()
    Dim WdApp As Object, bNewApp As Boolean
    Const Duongdanchuky = "D:\PDF\chuky.png"
    Dim Pic As Object
    On Error Resume Next
    Set WdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If WdApp Is Nothing Then
        Set WdApp = CreateObject("Word.Application")
        bNewApp = True
    End If
    With WdApp.Documents.Open("D:\PDF\Test1 - Copy.docx")
        With .Sections(1).Footers(1)
            Set Pic = .Shapes.AddPicture(Filename:=Duongdanchuky, LinkToFile:=False, SaveWithDocument:=True)
            Pic.WrapFormat.Type = 5
            .Shapes.Range(Pic.Name).Align 1, True
            .PageNumbers.Add (1)
        End With
        .Save:  .Close
    End With
    If bNewApp Then WdApp.Quit
End Sub
 

jeck09nt

Thành viên mới
Tham gia ngày
29 Tháng mười 2006
Bài viết
6
Được thích
3
Điểm
665
Tôi đọc lại thì thấy bạn dùng code trên Excel. Bạn dùng code này thử.
Mã:
Sub PlaceTextInFooter_Test()
    Dim WdApp As Object, bNewApp As Boolean
    Const Duongdanchuky = "D:\PDF\chuky.png"
    Dim Pic As Object
    On Error Resume Next
    Set WdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If WdApp Is Nothing Then
        Set WdApp = CreateObject("Word.Application")
        bNewApp = True
    End If
    With WdApp.Documents.Open("D:\PDF\Test1 - Copy.docx")
        With .Sections(1).Footers(1)
            Set Pic = .Shapes.AddPicture(Filename:=Duongdanchuky, LinkToFile:=False, SaveWithDocument:=True)
            Pic.WrapFormat.Type = 5
            .Shapes.Range(Pic.Name).Align 1, True
            .PageNumbers.Add (1)
        End With
        .Save:  .Close
    End With
    If bNewApp Then WdApp.Quit
End Sub

Mình rất cám ơn bạn Huuthang_bd !!!
Mình thực hiện được rồi , chúc Bạn luôn dồi giàu sức khỏe nhé !!!
 
Top Bottom