三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

YouTubeで本人しか見れないスパムコメント 空気扱い?を初体験したオイオイ

YouTubeで本人しか見れないスパムコメント扱い?を初体験したオイオイ
(気が付いたのが今日で、前から空気・幽霊コメントだったねキット)
ソースコードの.xxxx などプロパティやメソッドがドメイン扱いされていて、変にURLと誤認されているのかなぁ?

他人から見えない 空気 幽霊 コメント

テスト説明:↑
YouTubeで自分の動画のコメント欄にVBAソースコードを載せてます。
コメントに載っていないと視聴者様からメッセージをいただいて、
確認してみると(ログインしてない状態やシークレットウインドウなど本人アカウント以外)
数件、確かにソースコードが見れないYouTubeコメントがありました。

objShape.Name など、
ドットNameがドメイン扱いされて、スパムコメントで弾かれるのか?
コメント欄にソースコードが貼れないので、コミニティでテストしてみる。
※ドットName以外が原因かもしれないけど・・・

以上、本人なのに、本人の動画にコメントしたのに、コメントが弾かれた件でした。


脱線・蛇足:大げさにマクロを組んでみた ぉぃぉぃ やりすぎだって・・・

蛇足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 VBAPowerPointのタイトルテキストを取得したい Shapes から テキストを取り出す
https://ken3memo.hatenablog.com/entry/2022/03/28/050014
だと、すべて、取得してしまうので、
現在処理中のスライドのみ、データを落とすように変更する。

も、よろしくお願いします。

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)