[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『二重線を書き込みたい』(MATU)
教えてください!
エクセルで文字の上に訂正線と言いますか、二重線を書き込みたいのですがどのようにすれば
いいでしょうか?
セルの書式設定の「フォント」タブの下線の設定に二重線がありますが、下線でなく 取り消し線を二重線にしたいと言う事ですか? (ケン)
オートシェイプの二重線を重ねるとか・・・ (ケン)
一度、二重線をオートシェイプで描いておき、後はそれをCtrlを押しながら 任意の場所にドロップする。位しか・・・ 他の方のご意見をお待ちください。 (ケン)
そうですね。何度もご返答いただき有難うございました。そのようにさせてもらいます。
有難うございました。
(MATU)
あっあっ、、二重線じゃないけど。。 せこく取り消し線で(^^; (SoulMan) Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Font.Strikethrough = True Then Target.Font.Strikethrough = False Else Target.Font.Strikethrough = True End If End Sub シートの見出しを右クリック→コードを表示させて、そこに貼り付けます。 取り消し線を引きたいところをダブルクリック 取り消し線があったら、削除 なかったら線を書く。。。 ちょっと、せこいかな???
(*'ω'*)......ん? 単線の取り消し線ならボタンがあるじゃにゃいの・・・。 (川野鮎太郎)
(゚o゚)げっ!!ぎゃぁ〜〜〜 退散 (SoulMan)
ワードには二重取り消し線があるのに何でエクセルに無いんですかね。 少し面白半分でやってみました。 ※PCによってズレがあると思いますが、多少係数で調整すればいけるかな・・・。(^_^A;
Sub 二重取り消し線()
'定数宣言'換算係数 Const W As Single = 6.28 '列幅に対する係数 Const H As Single = 1 '行高に対する係数 Const L As Single = 0.85 '文字数に対する係数
Application.ScreenUpdating = False MyRow = ActiveCell.Row MyCol = ActiveCell.Column DFW = ActiveCell.ColumnWidth '元の列幅 DFH = ActiveCell.RowHeight '元の行高
Set MyC = Cells(MyRow, MyCol) With MyC For i = 1 To MyRow MyRH = MyRH + Cells(i, 1).RowHeight Next i MyRH = MyRH - .RowHeight / 2
For ii = 1 To MyCol MyCW = MyCW + Cells(1, ii).ColumnWidth Next ii MyCW = MyCW - .ColumnWidth / 2 MyFS = .Font.Size 'フォントサイズ MyHA = .HorizontalAlignment '横位置 MyVA = .VerticalAlignment '縦位置 .Columns.AutoFit .Rows.AutoFit MyLo = .ColumnWidth * L '文字長さ取得 MyFH = .RowHeight '文字高さ取得 Columns(MyCol).ColumnWidth = DFW '元に戻す Rows(MyRow).RowHeight = DFH '元に戻す End With
'----座標位置計算----
Select Case MyHA Case 1 HStart = MyCW - DFW / 2 '横の始まり(左) Case -4108 HStart = MyCW - MyLo / 2 '(中央) Case -4152 HStart = MyCW + DFW / 2 - MyLo '(右) End Select
Select Case MyVA Case -4160 VStart = MyRH - DFH / 2 + MyFH / 2 '縦の始まり(上) Case -4108 VStart = MyRH '(中央) Case -4107 VStart = MyRH + DFH / 2 - MyFH / 2 '(下) End Select
'----二重線書き込み----
Set MyS = ActiveSheet With MyS.Shapes.AddLine(HStart * W, VStart * H, (HStart + MyLo) * W, VStart * H).Line .Style = msoLineThinThin .Weight = 3# End With Application.ScreenUpdating = True End Sub (川野鮎太郎)
皆さんマクロで考えるので私も・・・ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Myrng As Range Dim Mycenter As Single, Myleft As Single, Myright As Single
Cancel = True
Set Myrng = Target Mycenter = Myrng.Top + Myrng.Height / 2 Myleft = Myrng.Left Myright = Myrng.Left + Myrng.Width
With ActiveSheet.Shapes.AddLine(Myleft, Mycenter, Myright, Mycenter).Line .Style = msoLineThinThin .Weight = 3# End With End Sub (ケン)
おにょ・・・、TopやLeftでアクティブセルの位置が出るんだ(^_^A; 一個一個足して計算してしまった_/ ̄|○ il||li (川野鮎太郎)
あのぅ、、こうやってみるとσ(^◇^;)の品祖ざんす。_/ ̄|○ il||li こりゃほんとに別分野を開拓せにゃ( ̄□ ̄;)!! (SoulMan)
今更ながらの今更ですがぁ、、難産でした。 書いたら、消した方がいいかな?っと思いまして。。 シートモジュールに↓これを Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Intersect(Target, Range("A1:D5")) Is Nothing Then Exit Sub With Target With Me.Shapes.AddLine(.Left, .Top + .Height / 2, .Left + .Width, .Top + .Height / 2) .OnAction = "削除" .Line.Style = msoLineThinThin .Line.Weight = 3# .Line.ForeColor.SchemeColor = 12 End With End With End Sub 標準モジュールにこれを貼り付けてください。 Sub 削除() Dim MyName As String MyName = ActiveSheet.Shapes(Application.Caller).Name ActiveSheet.Shapes(MyName).Delete End Sub Sub 変色() Dim MyName As String MyName = ActiveSheet.Shapes(Application.Caller).Name ActiveSheet.Shapes(MyName).Select With Selection If .ShapeRange.Line.ForeColor.SchemeColor = 12 Then .ShapeRange.Line.ForeColor.SchemeColor = 10 Else .ShapeRange.Line.ForeColor.SchemeColor = 12 End If End With ActiveCell.Select End Sub おまけです。 .OnAction = "削除" を↓に変更すると .OnAction = "変色" 色も変わります。 (SoulMan)
それこそ、WORDを使ったらいいのではないですか? 別に計算するわけではないんですよね? 表計算ソフトを使っていて、文字列操作の機能に不満をもたれても・・・ (コナミ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.