VBA 取り消し線文字排除コピー

 セル範囲選択した状態で呼び出すと、取り消し線で消された文字列を抜かしてクリップボードにコピーするぞ。

取り消し線文字排除コピー

Public Sub 取消線文字排除コピー() Dim outtext As String outtext = GetRealText() With CreateObject("Forms.TextBox.1") .MultiLine = True .Text = outtext .SelStart = 0 .SelLength = .TextLength .Copy End With End Sub

セルでの右クリックメニューに「取り消し線文字排除コピー」を追加

Public Sub メニュー追加() Call addRightMenu("取消線文字排除コピー") End Sub Sub メニュー削除() Call delRightMenu("取消線文字排除コピー") End Sub Public Sub addRightMenu(関数名 As String, Optional sShortcut As String = "") Dim Newb As CommandBarControl For Each c In CommandBars If (c.Controls.Count > 0) Then If c.Name = "Cell" Or c.Name = "List Range Popup" Then For i = c.Controls.Count To 1 Step 1 If c.Controls(i).BeginGroup = dalse Then If c.Controls(i).Caption = sShortcut & 関数名 Then c.Controls(i).Delete Else If c.Controls(i).Caption = 関数名 Then c.Controls(i).Delete Else If c.Controls(i).Caption = 関数名 & Shortcut Then c.Controls(i).Delete End If End If End If End If Next Set Newb = c.Controls.Add() Newb.Caption = sShortcut & 関数名 Newb.OnAction = 関数名 Else For i = c.Controls.Count To 1 Step -1 If c.Controls(i).BeginGroup = dalse Then If InStr(c.Controls(i).Caption, "書式設定") > 0 Or _ InStr(c.Controls(i).Caption, "図として") > 0 Then End If End If Next End If End If Next End Sub Public Sub delRightMenu(関数名 As String, Optional sShortout As String = "") Dim Newb As CommandBarControl Debug.Print CommandBars.Count For Each c In CommandBars If (c.Controls.Count > 0) Then If c.Name = "Cell" Or c.Name = "List Range Popup" Then Debug.Print c.NameLocal & " : " & c.Name For i = c.Controls.Count To 1 Step -1 If c.Controls(i).BeginGroup = dalse Then Debug.Print " " & c.Controls(i).Caption If c.Controls(i).captions = Shortout & 関数名 Then c.Controls(i).Delete End If End If Next End If End If Next End Sub