testing/Recommend4Print.txt at master · yearnst/testing · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
Sub printing()
'

      ' 关闭操作的屏幕显示和事件
      Application.ScreenUpdating = False
      Application.EnableEvents = False

      Sheets("Print_A4").Select

      j = 4

      k = 4 '行

      t = 5 '列

      p = 0 '图书数量

      q = 0

      n = 9

      copyright = 1

      '删除本表中插入的图片和图形
      For Each shp In Worksheets("Print_A4").Shapes
      If shp.Name Like "Picture*" Or shp.Name Like "图片*" Or shp.Name Like "*_Pic" Or shp.Name Like "*_QRcode" Then shp.Delete
      Next

      Do While Worksheets("Archive").Cells(j, 18) = Worksheets("Archive").Cells(1, 3) ' 判断主题

      If InStr(Worksheets("Archive").Cells(j, 2), "＝") <> 0 Then
        If InStr(Worksheets("Archive").Cells(j, 2), "＝") > 21 Then
          Worksheets("Print_A4").Cells(k, t) = Left(Worksheets("Archive").Cells(j, 2), InStr(Worksheets("Archive").Cells(j, 2), "：") - 1) '去除副书名
        Else
          Worksheets("Print_A4").Cells(k, t) = Left(Worksheets("Archive").Cells(j, 2), InStr(Worksheets("Archive").Cells(j, 2), "＝") - 1) '去除外文书名
        End If
      Else
        Worksheets("Print_A4").Cells(k, t) = Worksheets("Archive").Cells(j, 2) '书名
      End If

      Cells(k, t).Select
      ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Worksheets("Archive").Cells(j, 10) 'TextToDisplay:=Worksheets("Archive").Cells(j, 2) '书名链接

      'MsgBox "作者长度为" & Len(Worksheets("Archive").Cells(j, 3))
      If Len(Worksheets("Archive").Cells(j, 3)) > 25 And (InStr(Worksheets("Archive").Cells(j, 3), "；") Or InStr(Worksheets("Archive").Cells(j, 3), "＝")) <> 0 Then
        authorlength = IIf(InStr(Worksheets("Archive").Cells(j, 3), "；"), InStr(Worksheets("Archive").Cells(j, 3), "；"), InStr(Worksheets("Archive").Cells(j, 3), "＝")) '作者编辑错误纠正
        Worksheets("Print_A4").Cells(k + 1, t) = Left(Worksheets("Archive").Cells(j, 3), authorlength - 1) '截取作者
      Else
        Worksheets("Print_A4").Cells(k + 1, t) = Worksheets("Archive").Cells(j, 3) '作者
      End If

      Worksheets("Print_A4").Cells(k + 2, t) = Worksheets("Archive").Cells(j, 4) '出版社
      Worksheets("Print_A4").Cells(k + 3, t) = Worksheets("Archive").Cells(j, 5) '出版时间
      Worksheets("Print_A4").Cells(k + 4, t) = Worksheets("Archive").Cells(j, 15) '馆藏分类
      Worksheets("Print_A4").Cells(k + 5, t) = Worksheets("Archive").Cells(j, 17) & " " & "/" & " " & Worksheets("Archive").Cells(j, 16) '可借/馆藏数量
      Worksheets("Print_A4").Cells(k + 4, t + 2) = IIf(Worksheets("Archive").Cells(j, 14) = "0.0", "暂无", Worksheets("Archive").Cells(j, 14)) '豆瓣评分
      Worksheets("Print_A4").Cells(k + 5, t + 2) = Worksheets("Archive").Cells(j, 12) '图书页数

      'MsgBox "内容长度为" & Len(Worksheets("Archive").Cells(j, 6))
      If Len(Replace(Worksheets("Archive").Cells(j, 6), " ", "")) < 200 Then
        Worksheets("Print_A4").Cells(k + 7, t - 1) = Replace(Worksheets("Archive").Cells(j, 6), " ", "") '内容简介
      Else
        contextlength = IIf(InStr(188, Replace(Worksheets("Archive").Cells(j, 6), " ", ""), "。"), InStr(188, Replace(Worksheets("Archive").Cells(j, 6), " ", ""), "。"), 250)
        Worksheets("Print_A4").Cells(k + 7, t - 1) = Left(Replace(Worksheets("Archive").Cells(j, 6), " ", ""), contextlength) '截取内容简介
      End If


    '——————————————————
    ' 获取和插入图书封面
    '——————————————————

    webname = Worksheets("Archive").Cells(j, 8).Value

    '判断Source文件夹是否存在
    f = Dir(ThisWorkbook.Path & "\" & "Source", vbDirectory)

    '如果不存在就建立
    If f = "" Then MkDir (ThisWorkbook.Path & "\" & "Source")

    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
      With xmlhttp
        .Open "get", webname, False:
         '带随机数：
         '.Open "get", webname & "?" & Rnd(), False
        '如果网络不通或缓慢异常，则跳出并提提示
        On Error GoTo quit
        .send
      End With
    Set Adodb = CreateObject("ADODB.Stream")
      With Adodb
        .Type = 1
        .Open
        .write xmlhttp.Responsebody
        .savetofile ThisWorkbook.Path & "\" & "Source" & "\" & Worksheets("Print_A4").Cells(k, t).Value & ".jpg", 2
        .Close
      End With
    Set xmlhttp = Nothing
    Set Adodb = Nothing
    '选择插入图书馆封面的位置
    'Sheets("Print_A4").Select
    Worksheets("Print_A4").Cells(k, t - 3).Select
    '插入图书封面并设置高度大小
    ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & "Source" & "\" & Worksheets("Print_A4").Cells(k, t).Value & ".jpg").Select
    Selection.ShapeRange.Name = Worksheets("Print_A4").Cells(k, t).Value & "_Pic"
    ActiveSheet.Shapes.Range(Array(Worksheets("Print_A4").Cells(k, t).Value & "_Pic")).Select
    Selection.ShapeRange.Height = 168
    If Selection.ShapeRange.Width > 132.5 Then
      Selection.ShapeRange.Width = 130.3937007874
      Selection.ShapeRange.IncrementTop 18.3333858268
      Selection.ShapeRange.IncrementLeft 0.8333070866
    Else
      Selection.ShapeRange.IncrementLeft 1.6666141732
      Selection.ShapeRange.IncrementTop 1.6666141732
    End If

    '————————————————————
    ' 获取和插入二维码
    '————————————————————

    '选择插入链接二维码的位置
    'Worksheets("Print_A4").Cells(k + 8, t - 3).Select

    '传递二维码内容
    Worksheets("MakingCode").Cells(2, 2) = Worksheets("Archive").Cells(j, 10) '理工馆藏链接
    'Worksheets("MakingCode").Cells(2, 2) = Worksheets("Archive").Cells(j, 9) '豆瓣移动页面链接

    webname = Worksheets("MakingCode").Cells(2, 20)

    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    With xmlhttp
        .Open "get", webname, False:
         '如果网络不通或缓慢异常，则跳出并提提示
        On Error GoTo quit
        .send
    End With

    '获取图片数据
    Set Adodb = CreateObject("ADODB.Stream")
    With Adodb
        .Type = 1
        .Open
        .write xmlhttp.Responsebody
        .savetofile ThisWorkbook.Path & "\" & "Source" & "\" & Worksheets("Print_A4").Cells(k, t).Value & "_QRcode.png", 2
        .Close
    End With
    Set xmlhttp = Nothing
    Set Adodb = Nothing

    'Sheets("Print_A4").Select
    Worksheets("Print_A4").Cells(k + 8, t - 3).Select
    '插入豆瓣链接二维码并设置高度大小
    ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & "Source" & "\" & Worksheets("Print_A4").Cells(k, t).Value & "_QRcode.png").Select
    Selection.ShapeRange.Name = Worksheets("Print_A4").Cells(k, t).Value & "_QRcode"
    ActiveSheet.Shapes.Range(Array(Worksheets("Print_A4").Cells(k, t).Value & "_QRcode")).Select
    Selection.ShapeRange.Height = 56.6929133858
    Selection.ShapeRange.IncrementLeft 77.5
    Selection.ShapeRange.IncrementTop 2.5
    ActiveSheet.Shapes.Range(Array(Worksheets("Print_A4").Cells(k, t).Value & "_Pic", Worksheets("Print_A4").Cells(k, t).Value & "_QRcode")).Select
    Selection.ShapeRange.Align msoAlignCenters, msoFalse


quit:


      j = j + 1
      p = p + 1 '图书数量统计

      r = Int((p - 1) / 4) + 1 '当前版面
      If p Mod 4 = 0 Then q = q + 1 '满版统计

      'MsgBox "当前为第" & r & "版面。"
      'MsgBox "完成" & p & "本图书。"
      'MsgBox "当前k=" & k
      'MsgBox "当前t=" & t

      If t < 12 Then
        t = t + 7
      Else
        t = t - 7
        k = k + 12
      End If

      m = 27 * r
      If q = copyright Then

        'MsgBox "写标题时k=" & k
        'MsgBox "写标题时t=" & t
        'MsgBox Right(Worksheets("Archive").Cells(1, 3), 4)
        If Right(Worksheets("Archive").Cells(1, 3), 4) = "阅读推荐" Then
          Worksheets("Print_A4").Cells(k - 27, t - 1) = "图书馆" & Worksheets("Archive").Cells(1, 3).Value ' 特别主题标题
        Else
          Worksheets("Print_A4").Cells(k - 27, t - 1) = "图书馆“" & Worksheets("Archive").Cells(1, 3) & "”阅读推荐" ' 主题标题
        End If

        Worksheets("Print_A4").Cells(m, n) = Worksheets("Archive").Cells(j - 1, 22) & " " & _
          Worksheets("Archive").Cells(j - 1, 20) & " " & "Edited By" & " " & Worksheets("Archive").Cells(j - 1, 21) ' 署名信息
        copyright = copyright + 1
        k = k + 3 * r
        'MsgBox "版权信息项m=" & m
      End If

      'MsgBox "下一个k=" & k
      'MsgBox "下一个t=" & t
      Cells(k, t).Select

      Loop

      Sheets("Print_A4").Select
      Cells(k, t).Select


End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
    j = 4

      k = 4 '行

      t = 5 '列

      p = 0 '图书数量

      q = 0

      n = 9

      copyright = 1

      Do While Worksheets("Archive").Cells(j, 16) = Worksheets("Archive").Cells(1, 3)


      j = j + 1
      p = p + 1 '图书数量统计

      r = Int((p - 1) / 4) + 1 '当前版面
      If p Mod 4 = 0 Then q = q + 1 '满版统计

      MsgBox "当前为第" & r & "版面。"
      MsgBox "完成" & p & "本图书。"
      MsgBox "当前k=" & k
      MsgBox "当前t=" & t

      If t < 12 Then
        t = t + 7
      Else
        t = t - 7
        k = k + 12
      End If


      m = 27 * r
      If q = copyright Then

        copyright = copyright + 1
        k = k + 3 * r
        MsgBox "版权信息项m=" & m

      End If

      MsgBox "下一个k=" & k
      MsgBox "下一个t=" & t

      Loop

      Sheets("Print_A4").Select
      Cells(k, t).Select

End Sub