Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2010)
丸囲み数字について
投稿日時: 20/11/16 13:46:52
投稿者: abc_d

宜しくお願い致します。
 
丸囲み数字をテキストボックスに書き込むマクロを
作成していたのですが21番目以降をコードに書き込むと「?」
の表示になってしまいます。
 
50番までの丸囲み数字をテキストボックスに書き込むにはどのようにしたら
よいのでしょうか?
 
Dim Mno As Variant
Dim Mtop As Integer
Dim Mleft As Integer
Dim i As Integer
 
Mno = Array("@", "A", "B", "C", "D", "E", "F", "G", "H", "I", _
            "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", _
            "?")
With Selection
      Mtop = .Top
      Mleft = .Left
End With
 
For i = 0 To 20
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, Mleft, Mtop, 26.25 _
        , 21).Select
   With Selection
       .Characters.Text = Mno(i)
       .ShapeRange.Fill.Visible = msoFalse
       .ShapeRange.Line.Visible = msoFalse
       .ShapeRange.TextFrame2.TextRange.Font.Size = 12
   End With
     
      Mtop = Mtop + 10
      Mleft = Mleft + 20
 
   Next
 
どうぞよろしくお願い致します。

回答
投稿日時: 20/11/16 15:05:28
投稿者: Suzu

21以降の文字コードが判れば良いでしょうか?
 
21〜35 : &H3251 〜 &H325F (10進だと12881〜12895)
36〜50 : &H32B1 〜 &H32BF (10進だと12977〜12991)
 
=UNICHAR(12881) とでもして確認してみてください。
 
IMEパッドなら
文字一覧 にて、 JIS X0213 1面 にあります。

回答
投稿日時: 20/11/16 15:06:19
投稿者: sk

引用:
丸囲み数字をテキストボックスに書き込むマクロを
作成していたのですが21番目以降をコードに書き込むと「?」
の表示になってしまいます。

VBE のコードウィンドウでは Unicode 環境依存文字を
直接入力することは出来ません。
 
------------------------------------------------------------
 
ActiveCell.Value = ChrW(12881)
 
------------------------------------------------------------

回答
投稿日時: 20/11/16 15:31:23
投稿者: Suzu

引用:
VBE のコードウィンドウでは Unicode 環境依存文字を
直接入力することは出来ません。

 
あ・・それか。。
 
Dim strChar As String
 
'1〜20
For i = &H2460 To &H2473
    strChar = strChar & ChrW(i) & ","
Next
 
'21〜35
For i = &H3251 To &H325F
    strChar = strChar & ChrW(i) & ","
Next
 
'36〜50
For i = &H32B1 To &H32BF
    strChar = strChar & ChrW(i) & ","
Next
 
 
Mno = Split(strChar & "?", ",")
 
でテストしていたので気づきませんでした。

回答
投稿日時: 20/11/16 18:54:50
投稿者: WinArrow
投稿者のウェブサイトに移動

別案
 
予めセルA1〜A50に
@〜㊿を入力しておく。
 
A1セル:➀
A21セル:㉑
A36セル:㊱
 
※㉑と㊱は、「挿入」−「記号と特殊文字」を使って入力
A2〜A20、A22〜A35、A37〜A50は、↓のような数式を入力
例A2セル
=UNICHAR(UNICODE(A1)+1)
 
このA1〜A50の値をテキストボックスに代入すればよいでしょう。

回答
投稿日時: 20/11/16 19:00:16
投稿者: WinArrow
投稿者のウェブサイトに移動

↑のサンプルコード
 
Sub TEST()
Dim i As Long
Dim Mleft As Single, Mtop As Single
Dim TBOX, TXT As String
 
    With ActiveSheet
        For i = 1 To 50
            Mleft = .Cells(i, "B").Left: Mtop = .Cells(i, "B").Top: TXT = .Cells(i, "A").Value
            Set TBOX = .Shapes.AddTextbox(msoTextOrientationHorizontal, Mleft, Mtop, 26.25, 21)
            With TBOX
                .Name = "TBOX" & Format(i, "00")
                With .DrawingObject
                    .Text = TXT
                    .ShapeRange.Fill.Visible = msoFalse
                    .ShapeRange.Line.Visible = msoFalse
                    .ShapeRange.TextFrame2.TextRange.Font.Size = 12
                End With
            End With
        Next
    End With
 
End Sub

回答
投稿日時: 20/11/16 19:08:14
投稿者: WinArrow
投稿者のウェブサイトに移動

ごめんなさい
 
UNICODE関数、UNICAHR関数は
Excel2010では使えないかも?

回答
投稿日時: 20/11/16 19:12:55
投稿者: simple

Excel2013からですね。

投稿日時: 20/11/17 09:32:05
投稿者: abc_d

Suzu様
sk様
WinArrow様
こんにちは。
ご回答ありがとうございます。

セルに入力して取り出すという発想はいろいろとやり方があるんだなと思いました。

今回Suzu様のコードをアレンジして対応させて頂きました。

おかげさまでマクロが出来ました。
ありがとうございました。

MAdd = ActiveCell.Address(False, False)

For OpBtn = 1 To 3
MAry = Array("1", "21", "36")
    If Me.Controls("OptionButton" & OpBtn).Value = True Then
'            HfInt = Me.Controls("OptionButton" & i).Caption
             HfInt = MAry(OpBtn)
    End If
             
Next
        
        
    With Selection
      Mtop = .Top
      Mleft = .Left
End With

    '1〜20
    If HfInt >= 1 And HfInt <= 20 Then
             For i = &H2460 To &H2473
                 strChar = ChrW(i)
                                             ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                Mleft, Mtop, 26.25, 21).Select
                                        With Selection
                                            .Characters.Text = strChar
                                            .ShapeRange.Fill.Visible = msoFalse
                                            .ShapeRange.Line.Visible = msoFalse
                                            .ShapeRange.TextFrame2.TextRange.Font.Size = 12
                                        End With
                
                                                Mtop = Mtop + 10
                                                Mleft = Mleft + 20
            
             Next
    '21〜35
    ElseIf HfInt >= 21 And HfInt <= 35 Then
          For i = &H3251 To &H325F

                      strChar = ChrW(i)
                                             ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                Mleft, Mtop, 26.25, 21).Select
                                        With Selection
                                            .Characters.Text = strChar
                                            .ShapeRange.Fill.Visible = msoFalse
                                            .ShapeRange.Line.Visible = msoFalse
                                            .ShapeRange.TextFrame2.TextRange.Font.Size = 12
                                        End With
                
                                                Mtop = Mtop + 10
                                                Mleft = Mleft + 20
         Next
   '35〜50
     ElseIf HfInt >= 36 And HfInt <= 50 Then
          For i = &H32B1 To &H32BF

                      strChar = ChrW(i)
                                             ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                Mleft, Mtop, 26.25, 21).Select
                                        With Selection
                                            .Characters.Text = strChar
                                            .ShapeRange.Fill.Visible = msoFalse
                                            .ShapeRange.Line.Visible = msoFalse
                                            .ShapeRange.TextFrame2.TextRange.Font.Size = 12
                                        End With
                
                                                Mtop = Mtop + 10
                                                Mleft = Mleft + 20
           Next
                Else
'                MsgBox "変換対象範囲外です。", , "再選択してください"
'                Exit Sub

    End If
    Range(MAdd).Offset(2, 0).Select