040384 ランダム
 HOME | DIARY | PROFILE 【フォローする】 【ログイン】

在宅仕事日記

在宅仕事日記

PR

Keyword Search

▼キーワード検索

Calendar

Profile

tanpopo3416

tanpopo3416

Favorite Blog

SUGAR CANE INDIGO☆BLUEさん
気楽に行こう♪ モア☆さん
ビミョウな隣人 はるぎぃさん
SOHO翻訳者の仕事部屋 まな!さん

Comments

tanpopo3416@ Re:Excel VBA グループ解除、再グループ化(07/20) 「VBA オートシェイプのグループを再帰的…
jone@ Re:Excel VBA グループ解除、再グループ化(07/20) ワークシート版も考えてみました。 図A,…
tanpopo3416@ Re[1]:Excel VBA グループ解除、再グループ化(07/20) jone さんへ 「オートシェイプをコピーし…
tanpopo3416@ Re:Excel VBA グループ解除、再グループ化(07/20) コメントありがとうございます。 >図…
jone@ Re:Excel VBA グループ解除、再グループ化(07/20) 私も挑戦していました。久しぶりのプログ…

Freepage List

Oct 24, 2023
XML
カテゴリ:Word VBA
追記:2023年12月4日
マクロの記事は下記のサイトで書くことにしました。
Word VBA/マクロ 備忘録


Sub GetMarkerList()
'蛍光マーカー(ハイライト)の一覧を作成します。
    Dim rng As Range, mkrList As String, dcNew As Document
    Set rng = ActiveDocument.Range(0, 0)
    With rng.Find
        .Highlight = True
    End With
    
    With rng
        Do While .Find.Execute = True
            mkrList = mkrList & rng.Information(wdActiveEndPageNumber) _
                & vbTab & rng.Text & vbCrLf
            .SetRange .End, .End
        Loop
    End With
    If mkrList = "" Then
        MsgBox "ハイライトはありませんでした。"
        Exit Sub
    End If
    Set dcNew = Documents.Add
    With dcNew.PageSetup
        .TopMargin = MillimetersToPoints(30)
        .BottomMargin = MillimetersToPoints(30)
        .LeftMargin = MillimetersToPoints(30)
        .RightMargin = MillimetersToPoints(30)
    End With
    dcNew.Range(0, 0).InsertBefore mkrList
    
    With Selection
        .WholeStory
        .ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
            AutoFitBehavior:=wdAutoFitFixed
        .InsertRowsAbove 1
        .TypeText Text:="ページ"
        .MoveRight Unit:=wdCell
        .TypeText Text:="ハイライト"
        With .Tables(1)
            .Style = "表 (格子)"
            .ApplyStyleHeadingRows = True
            .PreferredWidthType = wdPreferredWidthPercent
            .PreferredWidth = 100
            .Columns(1).PreferredWidth = 10
            .Columns(2).PreferredWidth = 90
        End With
    End With
End Sub





お気に入りの記事を「いいね!」で応援しよう

Last updated  Dec 4, 2023 10:20:28 AM
コメント(0) | コメントを書く


【毎日開催】
15記事にいいね!で1ポイント
10秒滞在
いいね! --/--
おめでとうございます!
ミッションを達成しました。
※「ポイントを獲得する」ボタンを押すと広告が表示されます。
x

© Rakuten Group, Inc.