vba पृष्ठ संख्या, फ़ाइल पथ और छवि के साथ पृष्ठ पादरी कैसे सम्मिलित करें?



image text (1)

मैंने कुछ काम किया है इसके बड़ा तो मैंने सोचा कि यह हो जाएगा मुझे यकीन है कि यह आपको शुरूआत के साथ शुरू हो गया है।

" वर्ड फूटर में वाई के संशोधित पृष्ठ x सम्मिलित करने के लिए " VBA पर अपने समाधान के साथ विशेषज्ञों- एक्सचेंज.com से कुछ मदद शामिल थी। मैंने इसे उस कोड में उल्लेखित किया है जहां मैं इसका प्रयोग फ़ील्ड में परीक्षण बदलने के लिए करता हूं।

जैसा कि आपके दूसरे प्रश्न में " पादर्स / हेडर को प्रभावित किए बिना पृष्ठ संख्या को कैसे सक्षम किया जाए " मैं खाली सीमाओं के साथ तालिकाओं का उपयोग करने के लिए दृष्टिकोण का पालन करता हूं वे आपको बहुत सटीक सामग्री रखने की अनुमति देते हैं यही कारण है कि नीचे दिए गए कोड तीन स्तंभों के साथ एक तालिका डालेंगे:

 ___________________ ________________________ ___________
|_Your footer text__|_Center part if needed__|_Page X/Y__|

नीचे कोड ढूंढें मुख्य विधि InsertFooter आप अपने कोड से कॉल करना चाहते हैं। यह आपकी इच्छानुसार क्या करेगा:

Sub InsertFooter()

Dim footer As HeaderFooter
Dim footerRange As range
Dim documentSection As Section
Dim currentView As View
Dim footerTable As table
Dim pictureShape As Shape

On Error GoTo MyExit

' Disable updating to prevent flickering
Application.ScreenUpdating = False

For Each documentSection In ActiveDocument.Sections
    For Each footer In documentSection.Footers
        If footer.Index = wdHeaderFooterPrimary Then
            Set footerRange = footer.range
            ' add table to footer
            Set footerTable = AddTableToFooter(footerRange)
            ' Make table border transparent
            SetTableTransparentBorder footerTable
            ' Insert page X out of Y into third column in table
            InsertPageNumbersIntoTable footerTable
            ' Insert file path
            InsertFilePathIntoTable footerTable
            ' Add picture to footer
            AddPictureToFooter footerRange, "C:\Pictures\happy.jpg", 3
        End If
    Next footer
Next documentSection

MyExit:
' Enable updating again
Application.ScreenUpdating = True
Application.ScreenRefresh

End Sub

Sub AddPictureToFooter(range As range, filePath As String, pictureHeightInCm As Single)
    Set pictureShape = range.InlineShapes.AddPicture(FileName:=filePath, LinkToFile:=False, SaveWithDocument:=True).ConvertToShape
    pictureShape.WrapFormat.Type = wdWrapFront
    pictureShape.height = CentimetersToPoints(pictureHeightInCm)
    pictureShape.Top = 0
End Sub

Sub InsertPageNumbersIntoTable(tableToChange As table)
    ' Attention no error handling done!

    ' inserts "Page {page} of {pages}" into the third column of a table
    Dim cellRange As range
    Set cellRange = tableToChange.Cell(1, 3).range
    cellRange.InsertAfter "Page { PAGE } of { NUMPAGES }"
    TextToFields cellRange
End Sub


' Credits go to
' https://www.experts-exchange.com/questions/23467589/VBA-to-insert-a-modified-Page-x-of-y-in-a-Word-Footer.html#discussion
Sub TextToFields(rng1 As range)
    Dim c As range
    Dim fld As Field
    Dim f As Integer
    Dim rng2 As range
    Dim lFldStarts() As Long

    Set rng2 = rng1.Duplicate
    rng1.Document.ActiveWindow.View.ShowFieldCodes = True

    For Each c In rng1.Characters
        DoEvents
        Select Case c.Text
            Case "{"
                ReDim Preserve lFldStarts(f)
                lFldStarts(f) = c.Start
                f = f + 1
            Case "}"
                f = f - 1
                If f = 0 Then
                    rng2.Start = lFldStarts(f)
                    rng2.End = c.End
                    rng2.Characters.Last.Delete '{
                    rng2.Characters.First.Delete '}
                    Set fld = rng2.Fields.Add(rng2, , , False)
                    Set rng2 = fld.Code
                    TextToFields fld.Code
                End If
            Case Else
        End Select
    Next c
    rng2.Expand wdStory
    rng2.Fields.Update
    rng1.Document.ActiveWindow.View.ShowFieldCodes = False
End Sub

Sub InsertFilePathIntoTable(tableToChange As table)
    ' Attention no error handling done!

    ' inserts "Page {page} of {pages}" into the third column of a table
    Dim cellRange As range
    Set cellRange = tableToChange.Cell(1, 1).range
    cellRange.InsertAfter "{ FILENAME \p }"
    TextToFields cellRange
End Sub

Sub SetTableTransparentBorder(tableToChange As table)
    tableToChange.Borders(wdBorderTop).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderRight).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
    tableToChange.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End Sub

Function AddTableToFooter(footerRange As range) As table
    Dim footerTable As table
    Set footerTable = ActiveDocument.Tables.Add(range:=footerRange, NumRows:=1, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
    ' Algin third column to right
    footerTable.Cell(1, 3).range.ParagraphFormat.Alignment = wdAlignParagraphRight
    Set AddTableToFooter = footerTable
End Function

मैं पाद लेख को प्रारूपित करने की कोशिश कर रहा हूं, इसलिए उसके पास पाद लेख के शीर्ष दाईं ओर पृष्ठ # (x का x) होता है, और फिर छवि को नीचे केंद्रित किया गया है मैंने पृष्ठ # के लिए एक एल्गोरिथ्म लिखना समाप्त कर दिया और फिर ऊपर की छवि सम्मिलित करने के लिए इनलाइनशिप का इस्तेमाल किया। समस्या यह है कि पाठ छवि के नीचे है और छवि केंद्रित नहीं है। किसी भी सहायता की सराहना की जाएगी।

.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).range.Paragraphs.Alignment = wdAlignParagraphCenter 'Centers Header'
.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).range.InlineShapes.AddPicture ("X:\EQP\Residential Maintenance Agreement\Archived RMA templates\AA Logo Swoops cropped 2.JPG") 'Calls for image header'
.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).range.Paragraphs.Alignment = wdAlignParagraphCenter 'Centers Footer'
.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).range.InlineShapes.AddPicture ("X:\EQP\Residential Maintenance Agreement\Footer Template.PNG")
With wdapp.ActiveDocument.Sections(1).Footers(1).range.Paragraphs(1)
    .range.InsertAfter vbCr & "Page "
    Set r = .range
    E = .range.End
    r.Start = E
    .range.Fields.Add r, wdFieldPage
    .range.InsertAfter " of "
    E = .range.End
    r.Start = E
    .range.Fields.Add r, wdFieldNumPages
    .Alignment = wdAlignParagraphRight
    '.Alignment = wdAlignParagraphCenter
    '.range.InlineShapes.AddPicture ("X:\EQP\Residential Maintenance Agreement\Footer Template.PNG")
End With




footer