Sub \u30c6\u30ad\u30b9\u30c8\u30dc\u30c3\u30af\u30b9\u4f5c\u6210()
Dim originalShape As shape
Dim newShape As shape
Dim i As Integer, j As Integer
Dim horizontalSpacing As Single
Dim verticalSpacing As Single
Dim columns As Integer
Dim shapeCounts As Variant
Dim currentShape As Integer
Dim shapeIndex As Integer
Dim currentRow As Integer
Dim currentColumn As Integer<\/p>\n\n\n\n
' \u5217\u306e\u6570\u3092\u5165\u529b\u3059\u308b\u305f\u3081\u306eInputBox\u3092\u8868\u793a\ncolumns = InputBox(\"\u4f55\u5217\u306b\u3057\u307e\u3059\u304b\uff1f\uff08\u533a\u5207\u308b\u6570\u3088\u308a\u591a\u304f\uff09\", \"\u5217\u306e\u8a2d\u5b9a\", 3)\n' \u4f5c\u308b\u500b\u6570\u3092\u30b9\u30da\u30fc\u30b9\u3067\u533a\u5207\u3063\u3066\u5165\u529b\u3059\u308b\u305f\u3081\u306eInputBox\u3092\u8868\u793a\nshapeCounts = Split(InputBox(\"\u4f5c\u308b\u500b\u6570\u3092\u30b9\u30da\u30fc\u30b9\u3067\u533a\u5207\u3063\u3066\u5165\u529b\u3057\u3066\u304f\u3060\u3055\u3044\uff08\u4f8b\uff1a5 3 3 3 3 3\uff09\", \"\u500b\u6570\u306e\u8a2d\u5b9a\", \"5 3 3 3 3 3\"))\n\n' \u65b0\u3057\u3044\u30c6\u30ad\u30b9\u30c8\u30dc\u30c3\u30af\u30b9\u3092\u4f5c\u6210\nSet originalShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 4.52 * 28.35, 1.71 * 28.35) ' cm\u3092\u30dd\u30a4\u30f3\u30c8\u306b\u5909\u63db\nWith originalShape.TextFrame.Characters.Font\n .Name = \"Meiryo UI\"\n .Size = 11 ' \u4efb\u610f\u306e\u521d\u671f\u30b5\u30a4\u30ba\nEnd With\n' \u5857\u308a\u3064\u3076\u3057\u306a\u3057\u3001\u7dda\u306e\u8272\u306f\u9ed2\u3001\u7dda\u306e\u592a\u3055\u306f0.75\u306b\u8a2d\u5b9a\nWith originalShape.line\n .ForeColor.RGB = RGB(0, 0, 0)\n .Weight = 0.75\nEnd With\noriginalShape.Fill.Transparency = 1\n\n' \u9593\u9694\u306e\u8a2d\u5b9a\nhorizontalSpacing = 10\nverticalSpacing = 20\n\n' \u6307\u5b9a\u3055\u308c\u305f\u500b\u6570\u3067\u8907\u88fd\ncurrentShape = 1\ncurrentRow = 0\ncurrentColumn = 0\nFor shapeIndex = 0 To UBound(shapeCounts)\n For i = 1 To CInt(shapeCounts(shapeIndex))\n If currentShape > 1 Then\n ' \u8907\u88fd\u3092\u4f5c\u6210\n Set newShape = originalShape.Duplicate\n ' \u65b0\u3057\u3044\u4f4d\u7f6e\u3092\u8a2d\u5b9a\n newShape.Left = originalShape.Left + (originalShape.Width + horizontalSpacing) * currentColumn\n newShape.Top = originalShape.Top + (originalShape.Height + verticalSpacing) * currentRow\n ' \u30c7\u30d5\u30a9\u30eb\u30c8\u306e\u30d5\u30a9\u30f3\u30c8\u3092\u8a2d\u5b9a\n With newShape.TextFrame.Characters.Font\n .Name = \"Meiryo UI\"\n .Size = 11 ' \u4efb\u610f\u306e\u521d\u671f\u30b5\u30a4\u30ba\n End With\n ' \u5857\u308a\u3064\u3076\u3057\u306a\u3057\u3001\u7dda\u306e\u8272\u306f\u9ed2\u3001\u7dda\u306e\u592a\u3055\u306f0.75\u306b\u8a2d\u5b9a\n With newShape.line\n .ForeColor.RGB = RGB(0, 0, 0)\n .Weight = 0.75\n End With\n newShape.Fill.Transparency = 1\n End If\n currentShape = currentShape + 1\n currentColumn = currentColumn + 1\n If currentColumn >= columns Then\n currentColumn = 0\n currentRow = currentRow + 1\n End If\n Next i\n currentRow = currentRow + 1 ' \u5404\u584a\u306e\u9593\u306b1\u884c\u7a7a\u3051\u308b\n currentColumn = 0\nNext shapeIndex<\/code><\/pre>\n\n\n\nEnd Sub<\/p>\n\n\n\n
Sub \u30c6\u30ad\u30b9\u30c8\u30dc\u30c3\u30af\u30b9\u306b\u66f8\u304d\u8fbc\u307f()
Dim shp As shape
Dim i As Integer
Dim lastRow As Long
Dim firstLine As String
Dim secondLine As String
Dim pos As Long
Dim ws As Worksheet
Dim activeWs As Worksheet<\/p>\n\n\n\n
' \u30b7\u30fc\u30c8\u300cWORK\u300d\u3092\u8a2d\u5b9a\nSet ws = Worksheets(\"WORK\")\n' \u30a2\u30af\u30c6\u30a3\u30d6\u30b7\u30fc\u30c8\u3092\u8a2d\u5b9a\nSet activeWs = ActiveSheet\n\n' \u30b7\u30fc\u30c8\u300cWORK\u300d\u5185\u306e\u6700\u5f8c\u306e\u884c\u3092\u53d6\u5f97\nlastRow = ws.Cells(ws.Rows.Count, \"E\").End(xlUp).row\n\n' \u7a7a\u306e\u30c6\u30ad\u30b9\u30c8\u30dc\u30c3\u30af\u30b9\u306b\u5024\u3092\u57cb\u3081\u308b\ni = 1\nFor Each shp In activeWs.Shapes\n If shp.Type = msoTextBox Then\n If shp.TextFrame.Characters.text = \"\" Then\n If i <= lastRow Then\n ' 1\u884c\u76ee\u30682\u884c\u76ee\u306e\u5185\u5bb9\u3092\u8a2d\u5b9a\n firstLine = ws.Cells(i, \"E\").Value\n secondLine = ws.Cells(i, \"F\").Value\n shp.TextFrame.Characters.text = firstLine & vbCrLf & secondLine\n\n ' 1\u884c\u76ee\u306e\u30d5\u30a9\u30f3\u30c8\u8a2d\u5b9a\n With shp.TextFrame.Characters(1, Len(firstLine)).Font\n .Name = \"Meiryo UI\"\n .Size = 11\n End With\n\n ' 2\u884c\u76ee\u306e\u30d5\u30a9\u30f3\u30c8\u8a2d\u5b9a\n pos = Len(firstLine) + 2 ' 2\u884c\u76ee\u306e\u958b\u59cb\u4f4d\u7f6e\u3092\u8a2d\u5b9a\n With shp.TextFrame.Characters(pos, Len(secondLine)).Font\n .Name = \"Meiryo UI\"\n .Size = 8\n End With\n\n ' \u30c6\u30ad\u30b9\u30c8\u3092\u4e2d\u592e\u63c3\u3048\u306b\u8a2d\u5b9a\n shp.TextFrame.HorizontalAlignment = xlHAlignCenter\n\n i = i + 1\n Else\n Exit For\n End If\n End If\n End If\nNext shp<\/code><\/pre>\n\n\n\nEnd Sub<\/p>\n","protected":false},"excerpt":{"rendered":"
Sub \u30c6\u30ad\u30b9\u30c8\u30dc\u30c3\u30af\u30b9\u4f5c\u6210()Dim originalShape As shapeDim newShape As shapeDim i As Integer, j As IntegerDim horizontalSpa … <\/p>\n