YouTubeで本人しか見れないスパムコメント扱い？を初体験したオイオイ
(気が付いたのが今日で、前から空気・幽霊コメントだったねキット)
ソースコードの.xxxx などプロパティやメソッドがドメイン扱いされていて、変にURLと誤認されているのかなぁ？
テスト説明:↑
YouTubeで自分の動画のコメント欄にVBAのソースコードを載せてます。
コメントに載っていないと視聴者様からメッセージをいただいて、
確認してみると(ログインしてない状態やシークレットウインドウなど本人アカウント以外)
数件、確かにソースコードが見れないYouTubeコメントがありました。
objShape.Name など、
ドットNameがドメイン扱いされて、スパムコメントで弾かれるのか？
コメント欄にソースコードが貼れないので、コミニティでテストしてみる。
※ドットName以外が原因かもしれないけど・・・
以上、本人なのに、本人の動画にコメントしたのに、コメントが弾かれた件でした。
管理者側・管理者が指定可能なコメント処理は、
ken3memo.hatenablog.com
問題のソースコード？.プロパティやメソッドがリンク判断？
脱線・蛇足:大げさにマクロを組んでみた ぉぃぉぃ やりすぎだって・・・
蛇足1.パワポのアクティブスライドからオブジェクトの名前をエクセルに落とす Option Explicit '起動済みの既存 パワーポイント スライド .Shapes から テキストを取り出す 'アクティブシートに名前とテキストをセット Sub test20220915ppスライド内シェイプ名取得() Dim ppApp As Object 'As PowerPoint.Application Set ppApp = Nothing On Error Resume Next '取得エラー時に次へ Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If ppApp Is Nothing Then MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね" Exit Sub End If Dim r As Range '基準、左上のセル。ここではB5 Set r = Range("b5") Range(r, r.Offset(99, 2)).ClearContents '99行データを決め打ちでクリア '見出しを書き込む r.Range("A1")よりr.Offset(1, 0)と書いた方がよかったかも？ r.Range("A1") = "名前 Shape.Name" r.Range("B1") = "テキスト objShape.TextFrame.TextRange.Text" Dim p As Integer, y As Integer 'pページ、y行 Dim objShape As Object 'As PowerPoint.Shape パワポのシェイプ、テキスト、図形ほか y = 1 '取得したテキストデータを二行目から書きたいので p = ppApp.ActiveWindow.Selection.SlideRange.SlideIndex '選択しているページ For Each objShape In ppApp.ActivePresentation.Slides(p).Shapes r.Offset(y, 0) = objShape.Name 'オブジェクトの名前 0列目 'オブジェクトがテキストを持っているか？チェックしてからセット If objShape.HasTextFrame = msoTrue Then 'テキストフレームあり If objShape.TextFrame.HasText = msoTrue Then 'テキスト範囲あり r.Offset(y, 1) = objShape.TextFrame.TextRange.Text '1列目へテキスト End If End If y = y + 1 'セットする行を次へ Next MsgBox "処理終了" End Sub
蛇足2.Excelでアクティブスライドのppオブジェクトに名前を付ける※名前の変更
蛇足2.パワポのアクティブスライドのシェイプ名.Nameに値をセットして変更する
'起動済みのパワーポイント スライド .Shapes の名前 .Name変更 'アクティブシートの名前を使用してセット Sub test20220915ppスライド内シェイプ名変更() Dim ppApp As Object 'As PowerPoint.Application Set ppApp = Nothing On Error Resume Next '取得エラー時に次へ Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If ppApp Is Nothing Then MsgBox "パワポを取得できません。プレゼンスライドを開いてから、再テストしてね" Exit Sub End If Dim r As Range '基準、左上のセル。ここではB5 Set r = Range("b5") Dim p As Integer, y As Integer 'pページ、y行 Dim objShape As Object 'As PowerPoint.Shape パワポのシェイプ、テキスト、図形ほか Dim 変更前Name As String Dim 変更後Name As String p = ppApp.ActiveWindow.Selection.SlideRange.SlideIndex 'pp変更ページ '見出しの次から処理する.Office(1,0)なのでOffice(y,0) y=1 For y = 1 To 999 '最大999 そのまえにブレイク Exit Forさせるけど 変更前Name = Trim("" & r.Offset(y, 0).Value) 'データセット 変更後Name = Trim("" & r.Offset(y, 1).Value) 'データセット If Len(変更前Name) = 0 Then Exit For 'データ無しの時ループを抜ける '.Nameの変更 Set objShape = Nothing On Error Resume Next '取得エラー時に次へ※名前の禁則文字や重複？エラー Set objShape = ppApp.ActivePresentation.Slides(p).Shapes(変更前Name) '↑ここで、変更前の名前でアクセスできたか？ここで判断する On Error GoTo 0 'エラーを元に戻す※これを忘れると、デバッグ時にハマるから注意 If objShape Is Nothing Then 'エラー判断、エラーの時 r.Offset(y, 2).Value = "エラー発生、名前を確認してください" Else r.Offset(y, 2).Value = "" objShape.Name = 変更後Name '.Nameに単純に代入する End If Next y MsgBox "処理終了" End Sub
関連動画:
過去に作成した
https://www.youtube.com/watch?v=FZovWjt0xtQ
ken3memo.hatenablog.com
Excel VBA で PowerPointのタイトルテキストを取得したい Shapes から テキストを取り出す
https://ken3memo.hatenablog.com/entry/2022/03/28/050014
だと、すべて、取得してしまうので、
現在処理中のスライドのみ、データを落とすように変更する。
も、よろしくお願いします。
