Office関連

Slackのカスタム絵文字を一括作成するVBAマクロ

在宅勤務で使うビジネスチャットサービスとして注目されている「Slack」、私の会社でも導入しています。

Slackにはカスタム絵文字機能があり、私の会社でも「絵文字ジェネレーター」で作成した、

といった絵文字を使用しています。

総務という立場上、社内Slackの管理も行っているのですが、先日ある社員から「自分の名前の絵文字が欲しいんだけどー」と、相談を受けました。

なるほど。
たしかに「田中」や「佐藤」といった絵文字があると便利かもしれません。

とはいえ、絵文字ジェネレーターで個人情報となる名前で絵文字を作成するわけにはいきませんし、そもそも全従業員分の絵文字を一つずつ手作業で作成するのも大変です。

そこで、Excelの従業員リストを元に、Slackのカスタム絵文字を一括で作成するマクロを書くことにしました。

処理内容

マクロの大まかな処理内容は下記の通りです。

  1. カスタム絵文字の元となる画像(シェイプ)を作成
  2. クリップボードにコピー
  3. 画像として保存

クリップボードにコピーされた画像をファイルとして保存する際に使うのが、前回の記事(下記)で紹介したツール(CB2IMG)です。

VBAですべての処理を書けないことはないのですが、コードが複雑になる上に、透過色や画質にまでこだわり出すと非常に面倒くさいことになるので、この部分は無理せず外に出すことにしました。

“すべての処理をVBAで片づけない”、実運用上ではそんな視点も大事だと思います。

絵文字用シェイプを作成するVBAコード

まずは核となる、絵文字用シェイプを作成するコードです。
枠線や文字配置等いろいろと指定していますが、ポイントはワードアートの「変形」にある「四角」です。
これを指定することで、枠いっぱいに文字が広がり、カスタム絵文字にしたときに見やすくなります。

Private Function InsertShape(ByVal sht As Excel.Worksheet, _
                             ByVal shpText As String, _
                             Optional ByVal shpFontName As String = "MS UI Gothic", _
                             Optional ByVal shpForeColor As Long = &H0&, _
                             Optional ByVal shpBackColor As Long = &HFFFFFF) As Excel.Shape
'カスタム絵文字の元となるイメージ作成
'
' sht:イメージ作成先のシート
' shpText:文字列
' shpFontName:フォント
' shpForeColor:文字色
' shpBackColor:背景色
'

  Dim shp As Excel.Shape
  
  Set shp = sht.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
  With shp
    .TextEffect.PresetShape = msoTextEffectShapePlainText
    .ScaleHeight 1, msoFalse, msoScaleFromTopLeft
    .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
    .Height = 94.5 '出力後のサイズが大体 128 x 128ピクセル となるように調整
    .Width = 94.8
    .Line.Visible = msoFalse
    With .Fill
      '.Visible = msoFalse
      .Visible = msoTrue
      .ForeColor.RGB = shpBackColor
      .Transparency = 0
      .Solid
    End With
    With .TextFrame2
      .VerticalAnchor = msoAnchorMiddle
      .HorizontalAnchor = msoAnchorCenter
      .WordArtformat = msoTextEffect1
      With .TextRange
        .ParagraphFormat.Alignment = msoAlignCenter
        .ParagraphFormat.LineRuleWithin = msoFalse
        .ParagraphFormat.SpaceWithin = 10 '段落の間隔10pt
        If Len(shpText) > 2 Then
          .Text = Mid(shpText, 1, 2) & vbNewLine & Mid(shpText, 3) '3文字目以降は改行
        Else
          .Text = shpText
        End If
      End With
      With .TextRange.Font
        '.Line.Visible = msoFalse
        .Line.Transparency = 1
        .Shadow.Visible = msoFalse
        .Bold = msoTrue
        .Fill.ForeColor.RGB = shpForeColor
        .Name = shpFontName
        .NameAscii = shpFontName
        .NameFarEast = shpFontName
        .NameOther = shpFontName
      End With
    End With
  End With
  Set InsertShape = shp
End Function

使い方は下記のようになります。

Public Sub Sample()
  Dim shp As Excel.Shape
  Const cb2img As String = "C:\wk\CB2IMG\CB2IMG.exe" 'CB2IMGのパス
  
  '元画像作成
  Set shp = InsertShape(ActiveSheet, _
                        "齋藤花子", _
                        "UD Digi Kyokasho N-B", _
                        &HFFFFFF, _
                        &H57972B)
  'クリップボードにコピー
  shp.Copy
  'CB2IMGを実行してクリップボードにコピーされた画像をファイルとして保存
  Shell """" & cb2img & """ " & """C:\wk\CB2IMG\img\TEST.png""", vbNormalFocus
End Sub

「InsertShape」で作成したシェイプをクリップボードにコピーし、その後「CB2IMG」を実行してファイルとして保存しています。

Slackのカスタム絵文字を一括作成するVBAコード

あとは従業員リストを用意して繰り返し実行するだけです。
テストには下図のような、「疑似個人情報データ生成サービス」で生成したダミーデータを使うことにしました。

Public Sub BatchCreateEmoji()
'Slackのカスタム絵文字一括作成
  Dim sht As Excel.Worksheet
  Dim shp As Excel.Shape
  Dim wsh As Object
  Dim i As Long
  Const cb2img As String = "C:\wk\CB2IMG\CB2IMG.exe" 'CB2IMGのパス
  Const savefolder As String = "C:\wk\CB2IMG\img\" '画像保存先
  
  Set wsh = CreateObject("Wscript.Shell")
  Set sht = ActiveSheet
  With sht
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
      Set shp = InsertShape(sht, .Cells(i, 4).Value, , &H1400E5)
      DoEvents
      shp.Copy
       wsh.Run """" & cb2img & """ " & """" & savefolder & "name-" & .Cells(i, 5).Value & .Cells(i, 6).Value & ".png""", 0, True 'コマンド実行&処理待ち
      shp.Delete
    Next
  End With
  MsgBox "処理が終了しました。", vbSystemModal + vbInformation
End Sub

上記コードでは、CB2IMGの終了待ちを行うため、WshShell.Runメソッドを使用しています。
(処理中にSleepを挟んだ方が安定するかもしれません。)

実際にSlackで登録して使ったのが下図です。
フォントや文字色を調整すれば、もっと見やすくなるかもしれません。

画像が用意できたら後はアップするだけです。
Neutral Face Emoji Tools」を使えば、一括で登録できるのだとか。
(すみません。私は使ったことがないです・・・😅)

また、今回はExcelを使いましたが、PowerPointだとシェイプを直接保存できるExportメソッドが用意されているので、外部ツールを利用することなく処理できるかもしれません🤔

以上のように、Excelのオートシェイプを使ってSlackのカスタム絵文字を作成するマクロを書いてみました。
豊富に用意されている文字装飾効果を簡単に活かせるのがOfficeの強みですね!✨
カスタム絵文字作りにExcelやPowerPointを使う、意外とアリだと思います😁

関連記事

  1. Office アドイン

    「マイクロソフト Office 用アプリ開発スタートアップガイド」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。日本初(恐らく)…

  2. Office関連

    「ちゃうちゃう!」で2つの文書を比較するWordマクロ

    2014/08/10 追記:ちゃうちゃう!がバージョンアップされま…

  3. Office関連

    Office クリップボードをマクロで操作する(MSAA)

    MSDNフォーラムに質問がありましたが、Office クリップボードを…

  4. Office関連

    セルの行数をカウントするWordマクロ

    「ソースコードを番号行付きのテーブルに変換するWordマクロ」を実行し…

  5. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP