WORD 巨集求助

kunlingame
個人積分：24分
文章編號：84347572

24分

樓主

2022-03-07 15:48

各位先進好

繼上次文件內容完成
在最後又被新問題卡住
再次請求先進們支援
word vba
頁尾名稱
No. abc-AKB48G-3 3/7/2022 同一行中間為固定位置顯示日期
No. abc-AKB48G-11 紅字為版本可能有雙位數
MID(A2,FIND("-",A2)+1,FIND("-",A2,FIND("-",A2)+1)-FIND("-",A2)-1)
有找到找出中間的方式但此方式為excel適用，卻無法在word上提取出來，
打算將akb48g與後面1~2碼數字再+1當作儲存檔名 3+1
WORD 巨集求助

預計儲存檔名 abc4-AKB48g.docx
Sub 巨集1()
Dim RANGE As Long
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryFooter
Selection.EndKey unit:=wdLine, Extend:=wdExtend

Selection.RANGE.Copy
Documents.Add.Content.Paste
目前進度為把頁尾複製出來擷取想要字串再回主檔案當檔名存檔

求解麻煩各位先進協助指點方向
感謝您

2022-03-07 15:48 發佈

文章關鍵字 word

snare

snare
個人積分：3051分
文章編號：84359456

3051分

2樓

2022-03-08 21:13

word跟字型有關的，發問建議附範例檔
全形、半形、空格、連unicode、big5... 等等編碼，都有可能影響程式跑出來的結果



... 中間略 …

Selection.EndKey unit:=wdLine, Extend:=wdExtend
footer = Split(Split(Selection.Text, " ")(1), "-")
FileName = footer(0) & footer(2) + 1 & "-" & footer(1)
MsgBox FileName & ".docx"

... 中間略 …

or

Sub test()
    
    Dim footer, Filename As String
    footer = Split(Split(ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).RANGE.Text, " ")(1), "-")
    Filename = footer(0) & footer(2) + 1 & "-" & footer(1)
    MsgBox Filename & ".docx"

End Sub

kunlingame

kunlingame
個人積分：24分
文章編號：84362392

24分

樓主

2022-03-09 9:43

snare wrote:
word跟字型有關的(恕刪)

高手出手就是不一樣，
初心者的我想游標移動來刪除黃字與空白鍵格才來取紅的字
當暫存再回存檔名....
No. abc-AKB48G-3 3/9/2022

snare 大竟只用了四句文法就解決這問題
再請教snare 大如果擷取這些文字後
紅色的字能提換掉原本頁腳嗎?
No. abc-AKB48G-4 3/9/2022
其餘問題已測試可用
[點擊下載]

感謝snare 大再次出手協助

snare

snare
個人積分：3051分
文章編號：84368340

3051分

4樓

2022-03-09 21:33

kunlingame wrote:
紅色的字能提換掉原本頁腳嗎?


'請配合2樓範例使用
……中間略……
    Dim Oldfooter As String, Newfooter As String
    Oldfooter = Replace(ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text, Chr(13), "")
    Oldfooter = Right(Oldfooter, Len(Oldfooter) - 1)
    
    Newfooter = Replace(Oldfooter, footer(1) & "-" & footer(2), footer(1) & "-" & footer(2) + 1)
    ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = Newfooter
    ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True
……中間略……

kunlingame

kunlingame
個人積分：24分
文章編號：84375803

24分

樓主

2022-03-10 18:49

snare wrote:
'請配合2樓範例使用(恕刪)

加入後完成這次巨集
看完巨集寫法，我自學到完成可能要一~兩週
感謝snare大協助完成頁尾巨集