Skip to content

Instantly share code, notes, and snippets.

@YujiFukami

YujiFukami/ClipStrToDimString

Created October 22, 2022 07:52
Show Gist options
  • Save YujiFukami/00f7a81a578d0d4225af027292e400b2 to your computer and use it in GitHub Desktop.
Save YujiFukami/00f7a81a578d0d4225af027292e400b2 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
ClipStrToDimString
'ClipStrToDimString ・・・元場所：IkiAddin.ModClipboard
'GetClipboardText ・・・元場所：IkiAddin.ModClipboard
'ClipArray ・・・元場所：IkiAddin.ModClipboard
'Lib入力配列を処理用に変換・・・元場所：IkiAddin.ModLibrary
'ClipboardCopy ・・・元場所：IkiAddin.ModClipboard
'文字列を変数格納用に変換 ・・・元場所：IkiAddin.ModClipboard
'ConcatenateStr ・・・元場所：IkiAddin.ModStr
'ShowCodeWindow ・・・元場所：IkiAddin.ModAlignmentCode
'SendKeysWSH ・・・元場所：IkiAddin.ModSendKey
'宣言セクション※※※※※※※※※※※※※※※※※※※※※※※※※※※
'-----------------------------------
'元場所:IkiAddin.ModSendKey.PbwshShell
Public PbwshShell As Object
'宣言セクション終了※※※※※※※※※※※※※※※※※※※※※※※※※※※
Public Sub ClipStrToDimString(Optional ByRef ValueName As String = "Str", _
Optional ByRef Indent As Long = 4, _
Optional ByRef DeleteFirstStr As String = "'")
'クリップボードに格納された文字列を、文字列を変数宣言するコードに変換して、クリップボードに再格納する
'20220223
'紹介予定
'引数
'[ValueName] ・・・文字列を格納する変数名
'[Indent] ・・・インデントの半角スペース個数
'[DeleteFirstStr]・・・先頭文字を削除する場合のその先頭文字(省略なら「'」)
'クリップボードに格納された文字列を取得する
Dim ClipStr As String: ClipStr = GetClipboardText
'文字列を一次元配列に変換する
Dim StrArray1D As Variant
StrArray1D = Split(ClipStr, vbLf)
StrArray1D = WorksheetFunction.Transpose(WorksheetFunction.Transpose(StrArray1D))
'変数格納用文字列に変換する
Dim ClipArray As Variant
ClipArray = 文字列を変数格納用に変換(ValueName, StrArray1D, Indent, DeleteFirstStr)
'クリップボードに再格納
Call ClipboardCopy(ClipArray)
'コードウィンドウに戻る
Call ShowCodeWindow '20211223
End Sub
Private Function GetClipboardText()
'クリップボードに格納中の文字列データを取得する
'Microsoft Forms 2.0 Object Libraryを参照
'参考：http://officetanaka.net/excel/vba/tips/tips20.htm
'20210916
Dim OutputStr As String
Dim Clip As New DataObject
With Clip
.GetFromClipboard
OutputStr = .GetText
End With
GetClipboardText = OutputStr
End Function
Private Sub ClipArray(ByVal InputArray As Variant, _
Optional ByRef Message As Boolean = False)
'配列をクリップボードに格納して、セルにそのまま貼り付ける形にする。
'20210930
'引数
'InputArray・・・配列（一次元、二次元どちらでも可能）
'[Message] ・・・処理後のメッセージを表示するかどうか（デフォルトはFalse）
'引数処理
InputArray = Lib入力配列を処理用に変換(InputArray) '1スタートの二次元配列に変換する
'処理
Dim I As Long
Dim J As Long
Dim N As Long: N = UBound(InputArray, 1) '縦要素数計算
Dim M As Long: M = UBound(InputArray, 2) '横要素数計算
Dim OutputStr As String: OutputStr = ""
For I = 1 To N
For J = 1 To M
If J = 1 Then
OutputStr = OutputStr & InputArray(I, J)
Else
OutputStr = OutputStr & Chr(9) & InputArray(I, J) 'タブで区切る
End If
Next J
If I < N Then
OutputStr = OutputStr & vbCrLf '改行追加
End If
Next I
Call ClipboardCopy(OutputStr, Message)
End Sub
Private Function Lib入力配列を処理用に変換(InputHairetu)
'入力した配列を処理用に変換する
'1次元配列→2次元配列
'数値か文字列→2次元配列(1,1)
'要素の開始番号を1にする
'20210721
'20220304 変数の型変更
'20220531 修正
Dim Output As Variant
Dim I As Long
Dim M As Long
Dim N As Long
Dim Base1 As Long
Dim Base2 As Long
If IsArray(InputHairetu) = False Then
'配列でない場合(数値か文字列)
ReDim Output(1 To 1, 1 To 1)
Output(1, 1) = InputHairetu
Else
On Error Resume Next
M = UBound(InputHairetu, 2)
On Error GoTo 0
If M = 0 Then
'1次元配列
If UBound(InputHairetu, 1) = 1 Then '20220531修正
ReDim Output(1 To 1, 1 To 1)
Output(1, 1) = InputHairetu(1)
Else
Output = WorksheetFunction.Transpose(InputHairetu)
End If
Else
'2次元配列
Base1 = LBound(InputHairetu, 1)
Base2 = LBound(InputHairetu, 2)
If Base1 <> 1 Or Base2 <> 1 Then
N = UBound(InputHairetu, 1)
If N = Base1 Then
'(1,M)配列
ReDim Output(1 To 1, 1 To M - Base2 + 1)
For I = 1 To M - Base2 + 1
Output(1, I) = InputHairetu(Base1, Base2 + I - 1)
Next I
Else
Output = WorksheetFunction.Transpose(InputHairetu)
Output = WorksheetFunction.Transpose(Output)
End If
Else
Output = InputHairetu
End If
End If
End If
Lib入力配列を処理用に変換 = Output
End Function
Private Sub ClipboardCopy(ByVal InputClipText As Variant, _
Optional ByRef Message As Boolean = False)
'入力テキストをクリップボードに格納
'配列ならば列方向をTabわけ、行方向を改行する。
'20210719作成
'参考:http://blog.livedoor.jp/aero_iki-jibundakemacro/archives/30565154.html
'入力した引数が配列か、配列の場合は1次元配列か、2次元配列か判定
Dim HairetuHantei As Long
Dim Jigen1 As Long
Dim Jigen2 As Long
If IsArray(InputClipText) = False Then
'入力引数が配列でない
HairetuHantei = 0
Else
On Error Resume Next
Jigen2 = UBound(InputClipText, 2)
On Error GoTo 0
If Jigen2 = 0 Then
HairetuHantei = 1
Else
HairetuHantei = 2
End If
End If
'クリップボードに格納用のテキスト変数を作成
Dim Output As String
Dim I As Long
Dim J As Long
Dim M As Long
Dim N As Long
If HairetuHantei = 0 Then '配列でない場合
Output = InputClipText
ElseIf HairetuHantei = 1 Then '1次元配列の場合
If LBound(InputClipText, 1) <> 1 Then '最初の要素番号が1出ない場合は最初の要素番号を1にする
InputClipText = Application.Transpose(Application.Transpose(InputClipText))
End If
N = UBound(InputClipText, 1)
Output = ""
For I = 1 To N
If I = 1 Then
Output = InputClipText(I)
Else
Output = Output & vbLf & InputClipText(I)
End If
Next I
ElseIf HairetuHantei = 2 Then '2次元配列の場合
If LBound(InputClipText, 1) <> 1 Or LBound(InputClipText, 2) <> 1 Then
InputClipText = Application.Transpose(Application.Transpose(InputClipText))
End If
N = UBound(InputClipText, 1)
M = UBound(InputClipText, 2)
Output = ""
For I = 1 To N
For J = 1 To M
If J < M Then
Output = Output & InputClipText(I, J) & Chr(9)
Else
Output = Output & InputClipText(I, J)
End If
Next J
If I < N Then
Output = Output & Chr(10)
End If
Next I
End If
'クリップボードに格納'参考 https://www.ka-net.org/blog/?p=7537
With CreateObject("Forms.TextBox.1")
.MultiLine = True
.Text = Output
.SelStart = 0
.SelLength = .TextLength
.Copy
End With
'格納したテキスト変数をメッセージ表示
If Message Then
MsgBox ("「" & Output & "」" & vbLf & _
"をクリップボードにコピーしました。")
End If
End Sub
Private Function 文字列を変数格納用に変換(ByRef ValueName As String, _
ByRef StrArray1D As Variant, _
Optional ByRef Indent As Long = 4, _
Optional ByRef DeleteFirstStr As String = "'") _
As Variant
'20220223
'引数
'ValueName ・・・文字列を格納する変数名
'StrArray1D ・・・格納する文字が入った一次元配列
'[Indent] ・・・インデントの半角スペース個数
'[DeleteFirstStr]・・・先頭文字を削除する場合のその先頭文字(省略なら「'」)
Dim I As Long
Dim N As Long: N = UBound(StrArray1D, 1)
Dim Output As Variant: ReDim Output(1 To N + 1)
Dim AddCode As String
Output(1) = ConcatenateStr(String(Indent, " "), "Dim ", ValueName, " As String")
For I = 1 To N
AddCode = StrArray1D(I)
AddCode = Replace(AddCode, vbLf, "") '改行を消去
AddCode = Replace(AddCode, vbCr, "") '改行を消去
If InStr(AddCode, """") > 0 Then 'ダブルコーテーションは2回続ける
AddCode = Replace(AddCode, """", String(2, """"))
End If
If Mid(AddCode, 1, 1) = DeleteFirstStr And DeleteFirstStr <> "" Then '先頭文字の消去
AddCode = Mid(AddCode, 2)
End If
If I < N Then
AddCode = ConcatenateStr("""", AddCode, """", " & VbLf")
Else
AddCode = ConcatenateStr("""", AddCode, """")
End If
Output(I + 1) = ConcatenateStr(String(Indent, " "), ValueName, " = ", ValueName, " & ", AddCode)
Next I
'出力
文字列を変数格納用に変換 = Output
End Function
Private Function ConcatenateStr(ParamArray Str() As Variant)
'文字列を連結する
'20220215
Dim StrList As Variant: StrList = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Str))
Dim Output As String
Dim I As Long
Dim N As Long: N = UBound(StrList, 1)
For I = 1 To N
Output = Output & StrList(I)
Next I
ConcatenateStr = Output
End Function
Private Sub ShowCodeWindow()
'表示中のコードウィンドウをフォーカスする。
'20211223
'20211227修正
Call SendKeysWSH("{F7}")
End Sub
Private Sub SendKeysWSH(ByVal Keys As String, Optional Wait As Boolean = False)
'https://santane.jp/wp/?p=355
'http://wsh.style-mods.net/ref_wshshell/sendkeys.htm
'20211227
'20220228 入力されたローマ字が大文字の場合は小文字にする
'大文字は小文字にする
Keys = StrConv(Keys, vbLowerCase)
'メモリ効率より動作速度を優先する場合
Static wshShell As Object
If PbwshShell Is Nothing Then
Set PbwshShell = CreateObject("WScript.Shell")
End If
Set wshShell = PbwshShell
Call wshShell.SendKeys(Keys, Wait)
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment