目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
65 / 118 ﾂﾘｰ ←次へ　｜　前へ→
【143】テロップ Jaka 06/3/13(月) 11:23 Excel[未読]
【144】追伸 Jaka 06/3/15(水) 11:31 Excel[未読]
【166】Re:テロップ マキチャン 06/12/23(土) 22:54 Excel[未読]
【169】Re:テロップ りん 06/12/25(月) 12:53 Excel[未読]
【171】Re:テロップ Jaka 06/12/26(火) 9:45 Excel[未読]
【174】Re:テロップ マキチャン 06/12/26(火) 21:11 Excel[未読]
【176】恥 Jaka 06/12/28(木) 9:15 Excel[未読]
【172】今だったらこんな風にします。 Jaka 06/12/26(火) 9:59 Excel[未読]
【143】テロップ
Excel  Jaka  - 06/3/13(月) 11:23 -
引用なし
パスワード
   お遊びですが、セル版テロップ。
（谷さん、ごめんなさい。）

気に食わない点を少々。
・文字数にあわせたセルのオートフィットの幅がビシっと決まらない。
・エクセルバージョンの違いで幅が違う。
・PCによってフォントが無い（他で代用される）から、余計に幅が決まらない。
・色の変化が解りづらい、にごって見える、残像が残る（数色の場合）。

（注意）
テロップの速度調整にAPIを使用していますから、
下記APIコードをモジュールの１番上に記載。
（全モジュール通して１個だけで良いです。）

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

***********************************************************
Sub テロップ流れ1_セル版()
　　Dim st1 As String, SP1 As String, TX1 As String, Flg As Boolean
　　Dim DefoFntIdx As Long, Defocol As Double, i As Long
　　Dim MAd　As String
　　
　　MAd = "B2"
　　st1 = "シート内容に注意！！"
　　SP1 = StrConv(Space(4), vbWide)　'間隔
　　
　　'文字を１回1回ループさせようと思ったが、最初に作っておくのが簡単。
　　For i = 1 To 6
　　　　TX1 = TX1 & st1 & SP1
　　Next

　　TX1 = TX1 & StrConv(Space(Int(Len(st1) \ 2)), vbWide)
　　With Range(MAd)
　　　　.Value = ""
　　　　If .Column > 1 Then
　　　　　 If .Offset(, -1).Formula = "" Then
　　　　　　　.Offset(, -1).Value = Space(1)
　　　　　　　Flg = True
　　　　　 End If
　　　　End If
　　　　DefoFntIdx = .Font.ColorIndex
　　　　Defocol = .ColumnWidth
　　　　With .Font
　　　　　　.ColorIndex = 2
　　　　　　.Name = "HG正楷書体-PRO"
　　　　　　'.FontStyle = "ﾒﾃﾞｨｳﾑ 太字 斜体" 'PCによって無い。2002
　　　　　　.Size = 20
　　　　　　.Bold = True
　　　　　　.Italic = True
　　　　End With
　　　　.HorizontalAlignment = xlRight
　　　　.Value = StrConv(Right(st1, Len(st1) - 4), vbWide)
　　　　.Columns.AutoFit
　　　　FitCol = .ColumnWidth
　　　　.ColumnWidth = FitCol
　　　　.Value = ""
　　　　.Font.ColorIndex = 3
　　　　
　　　　For i = 1 To Len(TX1)
　　　　　　.Value = .Value & Mid(TX1, i, 1)
　　　　　　Sleep 200
　　　　Next
　　　　
　　　　.ColumnWidth = Defocol
　　　　.Font.ColorIndex = DefoFntIdx
　　　　.ClearContents
　　　　If Flg Then
　　　　　.Offset(, -1).ClearContents
　　　　End If
　　End With
End Sub

*******************************************
Sub テロップ１色_セル版()
　　St1 = "お読みください！！"
　　SPS = 4
　　MAd = "B2"
　　With Range(MAd)
　　　　.Value = ""
　　　　DefoFntIdx = .Font.ColorIndex
　　　　Defocol = .ColumnWidth

　　　　With .Font
　　　　　　.ColorIndex = 2
　　　　　　.Name = "HG正楷書体-PRO"
　　　　　　'.FontStyle = "ﾒﾃﾞｨｳﾑ 太字 斜体" 'PCによって無い。2002
　　　　　　.Size = 20
　　　　　　.Bold = True
　　　　　　.Italic = True
　　　　　　.ColorIndex = 3
　　　　End With

　　　　.Value = StrConv(Space(Len(St1) + SPS - 1), vbWide) & "あ"
　　　　.Columns.AutoFit
　　　　FitCol = .ColumnWidth
　　　　.ColumnWidth = FitCol
　　　　.Value = ""
　　　　Tx1 = StrConv(Space(Len(St1) + SPS), vbWide)
　　　　.Value = Tx1
　　　　
　　　　For CC = 1 To 3
　　　　　　.Value = Left(Tx1, Len(Tx1) - 1) & Mid(St1, i + 1, 1)
　　　　　　For i = 1 To Len(St1)
　　　　　　　　Tx1 = Left(Tx1, Len(Tx1) - 1) & Mid(St1, i, 1)
　　　　　　　　.Value = Tx1
　　　　　　　　Sleep 200
　　　　　　　　For ii = Len(Tx1) To i Step -1
　　　　　　　　　　Tx1 = Left(Tx1, ii - 1) & Mid(St1, i, 1) & _
　　　　　　　　　　　　　StrConv(Space(Len(Tx1) - ii), vbWide)
　　　　　　　　　　.Value = Tx1
　　　　　　　　　　DoEvents
　　　　　　　　　　Sleep 20
　　　　　　　　Next
　　　　　　Next
　　　　　　Sleep 1200
　　　　Next
　　　　'フリッカー
　　　　For iii = 1 To 5
　　　　　　Sleep 400
　　　　　　.Value = ""
　　　　　　Sleep 400
　　　　　　.Value = Trim(Tx1)
　　　　Next
　　　　.ColumnWidth = Defocol
　　　　.Font.ColorIndex = DefoFntIdx
　　End With
End Sub

*******************************************
'1=黒、2=白、3=赤、4=黄緑、5=青、6=黄、7=ピンク、8=水色、9=茶、10=緑
'11=濃紺、12=黄土色、13=濃紫、16=灰色50%、54=紫、41=淡い青　 紫は茶色に見える。
'33=スカイブルー、46=オレンジ

*******************************************
Sub テロップ数色_セル版()
　　Dim IroTb As Variant, ColorNo As Long, CLNo As Long, St1 As String
　　Dim Defocol As Double, Tx1 As String, CC As Long, i As Long
　　Dim SPS As Long, MAd As String
　　IroTb = Array(1, 3, 5, 7, 33, 4, 3, 1)
　　St1 = "お読みください！！"
　　SPS = 4
　　MAd = "B2"
　　With Range(MAd)
　　　　Defocol = .ColumnWidth
　　　　With .Font
　　　　　　.ColorIndex = 2
　　　　　　.Name = "HG正楷書体-PRO"
　　　　　　'.FontStyle = "ﾒﾃﾞｨｳﾑ 太字 斜体" 'PCによって無い。2002
　　　　　　.Bold = True
　　　　　　.Italic = True
　　　　End With
　　　　If Val(Application.Version) = 8 Then
　　　　　 .Value = StrConv(Space(Len(St1) + SPS - 1), vbWide) & "あ"
　　　　Else
　　　　　 .Value = StrConv(Space(Len(St1) + SPS - 1), vbWide)
　　　　End If
　　　　.Columns.AutoFit
　　　　FitCol = .ColumnWidth
　　　　.ColumnWidth = FitCol
　　　　.Value = ""
　　　　.Font.ColorIndex = xlAutomatic
　　　　Tx1 = StrConv(Space(Len(St1) + SPS), vbWide)
　　　　.Value = Tx1
　　　　For CC = 1 To UBound(IroTb) - 1 '3
　　　　　 .Value = Left(Tx1, Len(Tx1) - 1) & Mid(St1, i + 1, 1)
　　　　　 If i = Len(St1) + 1 Then
　　　　　　　CLNo = ColorNo - 1
　　　　　 End If
　　　　　 .Characters(Start:=Len(Tx1), Length:=1).Font.ColorIndex = IroTb(CLNo)
　　　　　 DoEvents
　　　　　 For i = 1 To Len(St1)
　　　　　　　 If ColorNo >= UBound(IroTb) Then
　　　　　　　　　ColorNo = 0
　　　　　　　 Else
　　　　　　　　　ColorNo = CC
　　　　　　　 End If
　　　　　　
　　　　　　　 Tx1 = Left(Tx1, Len(Tx1) - 1) & Mid(St1, i, 1)
　　　　　　　 .Value = Tx1
　　　　　　　 .Characters(Start:=Len(Tx1), Length:=1).Font.ColorIndex = IroTb(ColorNo)
　　　　　　　 Sleep 200 '150
　　　　　　
　　　　　　　 For ii = Len(Tx1) To i Step -1
　　　　　　　　　 Tx1 = Left(Tx1, ii - 1) & Mid(St1, i, 1) & _
　　　　　　　　　　　　 StrConv(Space(Len(Tx1) - ii), vbWide)
　　　　　　　　　 .Value = Tx1
　　　　　　　　　 .Characters(Start:=ii, Length:=1).Font.ColorIndex = IroTb(ColorNo)
　　　　　　　　　 DoEvents
　　　　　　　　　 Sleep 30　'ここで、テロップ速度調整。
　　　　　　　 Next
　　　　　 Next
　　　　　 Sleep 1200
　　　　Next
　　　　.ColumnWidth = Defocol
　　　　'フリッカー
　　　　For iii = 1 To 5
　　　　　　Sleep 400
　　　　　　.Value = ""
　　　　　　Sleep 400
　　　　　　.Value = Trim(Tx1)
　　　　Next
　　End With
End Sub
【144】追伸
Excel  Jaka  - 06/3/15(水) 11:31 -
引用なし
パスワード
   後片付けのコードがろくに入ってませんから、追加しておいてください。

特にこれ、
>Sub テロップ流れ1_セル版()

文字数が多いからファイルサイズに影響がでます。
また、右寄せにしているので他のコードを続けて試すと、フリッカー時に右側によってしまいます。
セルに入力できる文字数に制限があるので、文字数が多い時はほどほどにするか途中で一旦クリアするようにしてください。
【166】Re:テロップ
Excel  マキチャン  - 06/12/23(土) 22:54 -
引用なし
パスワード
   ▼Jaka さん：　こんにちは
　たまたま、掲示板を見ていて、テロップのような動きをさせる方法がわかり、
　メモさせていただきました。すばらしいです。
　私は、まったくのVBA初心者です。ただ、文字を表示させることくらいはできるので、
　以前、同じようなことを考え、初心者なりに、実現はできました。
　今回、テロップ流れ1_セル版とほぼ、同じ動きが、そのとき考えた
　こんなダサい方法でもできます。
Sub AAA()
　Dim I As Long

For I = 1 To 10

　Sheets("SHEET1").Cells(3, 3) = ("シ")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シー")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容")
　 Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！！")
　　Sleep 200

　Next I

End Sub

この場合、表示セルの、書式にて、横の配置を右づめにしておきます。
すると右から左へ文字が流れていくように見えます。
また、表示セルの左のセルに何か文字を入力しておき、
文字を白くしておけば、あふれた場合に、消えていくように見えます。
何の参考にもなりませんが、達人の方と同じ動きを実現できていたので
少しうれしくて、投稿してしまいました。すみません。
もちろん、今後は、教えていただいた方法で、やっていきたいと思っています。
【169】Re:テロップ
Excel  りん E-MAIL  - 06/12/25(月) 12:53 -
引用なし
パスワード
   マキチャン さん、こんにちわ。
Jaka さんもこんにちわ。

>Sub AAA()
> 　Dim I As Long
>
> For I = 1 To 10
>
>　Sheets("SHEET1").Cells(3, 3) = ("シ")
>　　Sleep 200
＜＜略＞＞
>　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！！")
>　　Sleep 200
>
>　Next I
>
>End Sub

似た文が多いので、まとめたらこんな感じかな。
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub TEST()
　 Dim II As Integer, LL As Integer, AA As String
　 AA = "シート　内容に注意！！" 'メッセージ内容
　 '
　 For II = 1 To 10
　　　For LL = 1 To Len(AA) '文字数
　　　　 ActiveSheet.Cells(3, 3).Value = Left(AA, LL)
　　　　 Sleep 200
　　　Next LL
　 Next II
End Sub
【171】Re:テロップ
Excel  Jaka  - 06/12/26(火) 9:45 -
引用なし
パスワード
   りん さん、マキチャン さん、こんにちわ。
タイプライター方式ですね。
表示の仕方が違うだけで、おっしゃるとおりにやっていることは同じです。
（どちらも目の錯覚？を利用してます。）

りんさんのを勝手に改造

Sub TEST()
　 Dim II As Integer, LL As Integer, AA As String
　 AA = "シート　内容に注意！！" 'メッセージ内容
　 For II = 1 To 5
　　　ActiveSheet.Cells(3, 3).Value = Empty
　　　Sleep 330
　　　For LL = 1 To Len(AA) '文字数
　　　　 ActiveSheet.Cells(3, 3).Value = Left(AA, LL)
　　　　 'この辺に、Beep音の「カシャ」ってのがあれば、面白いと思います。
　　　　 If i <> 4 Then
　　　　　　Sleep 330
　　　　 End If
　　　Next LL
　 Next II
End Sub

おまけ。
プログレスバーも同じですね。
（前にりんさんが同じようなものを書いたかもしんないけど....）

Sub prog()
　Application.DisplayStatusBar = True
　cnt = 20999
　Joz = 1000
　moji = String(Int(cnt \ Joz), "□")
　Application.StatusBar = moji
　For i = 1 To cnt
　　 If i Mod Joz = 0 Then
　　　　Application.Wait Now + TimeValue("00:00:02")
　　　　moji = Application.Substitute(moji, "□", "■", 1)
　　　　Application.StatusBar = moji
　　 End If
　Next
　MsgBox "終了"
　Application.StatusBar = Empty
End Sub
【172】今だったらこんな風にします。
Excel  Jaka  - 06/12/26(火) 9:59 -
引用なし
パスワード
   上のテロップのコードをここに乗せたのは、今年ですが、書いたのは２、３年前なので、なぜこんな意味不明な計算式が入っているのか解りませんが...。
多分最後の文字が表示しきるまで待てなかったんじゃないかと思います。
>StrConv(Space(Int(Len(st1) \ 2))
今だったら、気が長くなったのか？
こんな風にします。
という事で、今頃ちょっと修正。

>Sub テロップ流れ1_セル版()
>　　Dim st1 As String, SP1 As String, TX1 As String, Flg As Boolean
>　　Dim DefoFntIdx As Long, Defocol As Double, i As Long
>　　Dim MAd　As String
>　　
>　　MAd = "B2"
>　　st1 = "シート内容に注意！！"
>　　SP1 = StrConv(Space(4), vbWide)　'間隔
>　　
>　　'文字を１回1回ループさせようと思ったが、最初に作っておくのが簡単。
>　　For i = 1 To 6
>　　　　TX1 = TX1 & st1 & SP1
>　　Next
>
>　　TX1 = TX1 & StrConv(Space(Int(Len(st1) \ 2)), vbWide)

　　　　↓　こんな感じに....。

　　st1 = "シート内容に注意！！"
　　SPCt = 3　'間隔
　　SP1 = StrConv(Space(SPCt), vbWide)
　　For i = 1 To 6
　　　　TX1 = TX1 & St1 & SP1
　　Next
　　TX1 = TX1 & StrConv(Space(Len(St1) - SPCt), vbWide)
【174】Re:テロップ
Excel  マキチャン  - 06/12/26(火) 21:11 -
引用なし
パスワード
   Jaka　さん　りんさん　こんばんは。

似た文が多いので、まとめたらこんな感じかな。
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub TEST()
　 Dim II As Integer, LL As Integer, AA As String
　 AA = "シート　内容に注意！！" 'メッセージ内容
　 '
　 For II = 1 To 10
　　　For LL = 1 To Len(AA) '文字数
　　　　 ActiveSheet.Cells(3, 3).Value = Left(AA, LL)
　　　　 Sleep 200
　　　Next LL
　 Next II
End Sub

私も多分、Len関数やMID関数などを使って、長さをまわせば
だらだら、書かなくても、できるのではと思っていました。
りんさんの上記のような方法を教えていただき、ありがとうございます。
これなら、人に見せても恥ずかしくないですよね。

ところで、Jakaさんのプログレスバー（こういう言葉もしらなかったです）
も、こういうことをしてみたかったので、非常に参考になります。
私は、仕方なく、シート上にボタンを表示してその大きさを変えて（だんだん
小さくなるようにして）我慢していました。

メモ、メモ、メモです。思い切って、投稿してみて非常に良かったと思っています。
おもわぬ収穫です。

皆さんありがとうございました。
【176】恥
Excel  Jaka  - 06/12/28(木) 9:15 -
引用なし
パスワード
   上記【171】Re:テロップにて、
私は、話のつながらない間抜けな発言をしてますが、　

>この場合、表示セルの、書式にて、横の配置を右づめにしておきます。
上のマキチャンさんの書き込みをまったく見ていなかったからです。
ごめんなさい。

マキチャンさん、なんのこっちゃ発言をして、すみませんでした。
ほんと間抜けですね....。と、思いつつ、年内に気づいてえらいぞJaka。

・・・・、失礼しました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
65 / 118 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：   
0
(SS)C-BOARD v3.8 is Free